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

Diff of /src/code/commandline.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.15.22.1 by rtoy, Sat Sep 27 05:24:44 2008 UTC revision 1.27 by rtoy, Tue May 31 13:26:40 2011 UTC
# Line 14  Line 14 
14  ;;;  ;;;
15    
16  (in-package "EXTENSIONS")  (in-package "EXTENSIONS")
17  (export '(*command-line-words* *command-line-switches*  
18    (intl:textdomain "cmucl")
19    
20    (export '(*command-line-application-arguments* *command-line-words* *command-line-switches*
21            *command-switch-demons* *command-line-utility-name*            *command-switch-demons* *command-line-utility-name*
22            *command-line-strings* *batch-mode*            *command-line-strings* *batch-mode*
23            cmd-switch-string command-line-switch-p            cmd-switch-string command-line-switch-p
24            cmd-switch-name cmd-switch-value cmd-switch-words command-line-switch            cmd-switch-name cmd-switch-value cmd-switch-words command-line-switch
25            defswitch cmd-switch-arg get-command-line-switch))            defswitch cmd-switch-arg get-command-line-switch))
26    
27    (defvar *command-line-application-arguments* ()
28      "A list of all the command line arguments after --")
29    
30  (defvar *command-line-switches* ()  (defvar *command-line-switches* ()
31    "A list of cmd-switch's representing the arguments used to invoke    "A list of cmd-switch's representing the arguments used to invoke
32    this process.")    this process.")
# Line 39  Line 45 
45    
46  (defvar *batch-mode* nil  (defvar *batch-mode* nil
47    "When True runs lisp with its input coming from standard-input.    "When True runs lisp with its input coming from standard-input.
48     If an error is detected returns error code 1, otherwise 0.")    If an error is detected returns error code 1, otherwise 0.")
49    
50  (defstruct (command-line-switch (:conc-name cmd-switch-)  (defstruct (command-line-switch (:conc-name cmd-switch-)
51                                  (:constructor make-cmd-switch                                  (:constructor make-cmd-switch
# Line 87  Line 93 
93            (return nil))            (return nil))
94          (push str *command-line-words*))          (push str *command-line-words*))
95        (setq str (pop cmd-strings)))        (setq str (pop cmd-strings)))
96    
97        (when (string= str "--")
98          ;; Handle the special case where -- is the first option.  The
99          ;; code below interprets that incorrectly and I (rtoy) don't
100          ;; want to mess with that, so just set up
101          ;; *command-line-application-arguments* and return.
102          (setf *command-line-application-arguments* cmd-strings)
103          (return-from process-command-strings nil))
104    
105      ;; Set command line switches.      ;; Set command line switches.
106      ;;      ;;
107      (loop      (loop
# Line 107  Line 122 
122                (push (make-cmd-switch switch value (nreverse word-list))                (push (make-cmd-switch switch value (nreverse word-list))
123                      *command-line-switches*)                      *command-line-switches*)
124                (return nil))                (return nil))
125    
126              (unless (zerop (length (the simple-string str)))              (unless (zerop (length (the simple-string str)))
127                (when (char= #\- (schar str 0))                (when (char= #\- (schar str 0))
128                  (push (make-cmd-switch switch value (nreverse word-list))                  (push (make-cmd-switch switch value (nreverse word-list))
129                        *command-line-switches*)                        *command-line-switches*)
130                    (when (and (= (length str) 2)
131                               (char= #\- (schar str 1)))
132                      ;; Gather up everything after --, and exit.
133                      (setf *command-line-application-arguments* cmd-strings)
134                      (setf str nil))
135                  (return nil))                  (return nil))
136                (push str word-list))                (push str word-list))
137              (setq str (pop cmd-strings))))))))              (setq str (pop cmd-strings))))))))
138    
139  (defun get-command-line-switch (sname)  (defun get-command-line-switch (sname)
140    "Accepts the name of a switch as a string and returns the value of the    "Accepts the name of a switch as a string and returns the value of
141     switch.  If no value was specified, then any following words are returned.    the switch.  If no value was specified, then any following words are
142     If there are no following words, then t is returned.  If the switch was not    returned.  If there are no following words, then t is returned.  If
143     specified, then nil is returned."    the switch was not specified, then nil is returned."
144    (let* ((name (if (char= (schar sname 0) #\-) (subseq sname 1) sname))    (let* ((name (if (char= (schar sname 0) #\-) (subseq sname 1) sname))
145           (switch (find name *command-line-switches*           (switch (find name *command-line-switches*
146                         :test #'string-equal                         :test #'string-equal
# Line 134  Line 155 
155  ;;;; Defining Switches and invoking demons.  ;;;; Defining Switches and invoking demons.
156    
157  (defvar *complain-about-illegal-switches* t  (defvar *complain-about-illegal-switches* t
158    "When set, invoking switch demons complains about illegal switches that have    "When set, invoking switch demons complains about illegal switches
159     not been defined with DEFSWITCH.")    that have not been defined with DEFSWITCH.")
160    
161  ;;; This is a list of legal switch names.  DEFSWITCH sets this, and  ;;; This is a list of lists consisting of the legal switch names,
162  ;;; INVOKE-SWITCH-DEMONS makes sure all the switches it sees are on this  ;;; switch description, and argument description.  The description and
163  ;;; list.  ;;; argument description can be NIL.  (Should probably do something
164    ;;; better, but this is good enough for the little bit of processing
165    ;;; that we need.)  DEFSWITCH sets this, and INVOKE-SWITCH-DEMONS
166    ;;; makes sure all the switches it sees are on this list.
167  ;;;  ;;;
168  (defvar *legal-cmd-line-switches* nil)  (defvar *legal-cmd-line-switches* nil)
169    
# Line 149  Line 173 
173  ;;;  ;;;
174  (defun invoke-switch-demons (&optional (switches *command-line-switches*)  (defun invoke-switch-demons (&optional (switches *command-line-switches*)
175                                           (demons *command-switch-demons*))                                           (demons *command-switch-demons*))
176    (dolist (switch switches t)    (flet ((invoke-demon (switch)
177      (let* ((name (cmd-switch-name switch))             (let* ((name (cmd-switch-name switch))
178             (demon (cdr (assoc name demons :test #'string-equal))))                    (demon (cdr (assoc name demons :test #'string-equal))))
179        (cond (demon (funcall demon switch))               (cond (demon (funcall demon switch))
180              ((or (member name *legal-cmd-line-switches* :test #'string-equal)                     ((or (member name *legal-cmd-line-switches* :test #'string-equal :key #'car)
181                   (not *complain-about-illegal-switches*)))                          (not *complain-about-illegal-switches*)))
182              (t (warn "~S is an illegal switch" switch)))                     (t (warn (intl:gettext "~S is an illegal switch") switch)))
183        (lisp::finish-standard-output-streams))))               (lisp::finish-standard-output-streams))))
184        ;; We want to process -help (or --help) first, if it's given.
185  (defmacro defswitch (name &optional function)      ;; Since we're asking for help, we don't want to process any of
186    "Associates function with the switch name in *command-switch-demons*.  Name      ;; the other switches.
187     is a simple-string that does not begin with a hyphen, unless the switch name      (let ((maybe-help (or (find "help" switches :key #'cmd-switch-name :test #'string-equal)
188     really does begin with one.  Function is optional, but defining the switch                            (find "-help" switches :key #'cmd-switch-name :test #'string-equal))))
189     is necessary to keep invoking switch demons from complaining about illegal        (if maybe-help
190     switches.  This can be inhibited with *complain-about-illegal-switches*."          (invoke-demon maybe-help)
191            (dolist (switch switches t)
192              (invoke-demon switch))))))
193    
194    (defmacro defswitch (name &optional function docstring arg-name)
195      "Associates function with the switch name in
196      *command-switch-demons*.  Name is a simple-string that does not
197      begin with a hyphen, unless the switch name really does begin with
198      one.  Function is optional, but defining the switch is necessary to
199      keep invoking switch demons from complaining about illegal switches.
200      This can be inhibited with *complain-about-illegal-switches*.
201    
202      The optional arguments, arg-name and docstring, are used by -help to
203      describe the switch.  Arg-name is a string naming the argument (if
204      any) for the switch.  Docstring describe the switch."
205    (let ((gname (gensym))    (let ((gname (gensym))
206          (gfunction (gensym)))          (gfunction (gensym)))
207        (when docstring
208          (intl::note-translatable intl::*default-domain* docstring))
209        (when arg-name
210          (intl::note-translatable intl::*default-domain* arg-name))
211      `(let ((,gname ,name)      `(let ((,gname ,name)
212             (,gfunction ,function))             (,gfunction ,function))
213         (check-type ,gname simple-string)         (check-type ,gname simple-string)
214         (check-type ,gfunction (or symbol function) "a symbol or function")         (check-type ,gfunction (or symbol function) (intl:gettext "a symbol or function"))
215         (push ,gname *legal-cmd-line-switches*)         (push (list ,gname ,docstring ,arg-name) *legal-cmd-line-switches*)
216         (when ,gfunction         (when ,gfunction
217           (push (cons ,gname ,gfunction) *command-switch-demons*)))))           (push (cons ,gname ,gfunction) *command-switch-demons*)))))
218    
# Line 185  Line 227 
227          (eval form)          (eval form)
228          (lisp::finish-standard-output-streams)          (lisp::finish-standard-output-streams)
229          (setf start next)))))          (setf start next)))))
230  (defswitch "eval" #'eval-switch-demon)  
231    ;; Docstrings should have lines longer than 72 characters so that we
232    ;; can print out the docstrings nicely on one line for help.
233    ;;                                                                     | <-- char 72
234    (defswitch "eval" #'eval-switch-demon
235      "Evaluate the specified Lisp expression during the start up
236      sequence.  the value of the form will not be printed unless it is
237      wrapped in a form that does output."
238      "expression")
239    
240  (defun load-switch-demon (switch)  (defun load-switch-demon (switch)
241    (load (cmd-switch-arg switch)))    (load (cmd-switch-arg switch)))
242  (defswitch "load" #'load-switch-demon)  
243    (defswitch "load" #'load-switch-demon
244      "Loads the specified file into Lisp before entering Lisp's
245      read-eval-print loop."
246      "filename")
247    
248  (defun cmd-switch-arg (switch)  (defun cmd-switch-arg (switch)
249    (or (cmd-switch-value switch)    (or (cmd-switch-value switch)
250        (car (cmd-switch-words switch))        (car (cmd-switch-words switch))
251        (car *command-line-words*)))        (car *command-line-words*)))
252    
253  (defswitch "core")  (defswitch "core" nil
254  (defswitch "init")    "Specifies the suspended Lisp image ('core' file) to start up"
255  (defswitch "noinit")    "corefile")
256  (defswitch "nositeinit")  
257  (defswitch "hinit")  (defswitch "init" nil
258  (defswitch "batch")    "Specifies the name of a file containing user customizations that is
259  (defswitch "dynamic-space-size")    to be loaded each time Lisp starts up (default ~/init or
260  (defswitch "lib")    ~/.cmucl-init.lisp).  The loader loads any existing compiled binary
261  (defswitch "quiet")    or the lisp source if none."
262  (defswitch "debug-lisp-search")    "filename")
263    
264    (defswitch "noinit" nil
265      "Suppresses loading of the init file and also prevents -edit from
266      loading the Hemlock init file.")
267    
268    (defswitch "nositeinit" nil
269      "Suppresses loading of the site-init site specific initialization
270      file.")
271    
272    (defswitch "hinit" nil
273      "Specifies the name of the Hemlock init file (default ~/hemlock-init
274      or ~/.hemlock-init), which is loaded only when Hemlock is started."
275      "filename")
276    
277    (defswitch "batch" nil
278      "Causes Lisp to run in batch mode where all input is directed from
279      standard-input.  A unix return code of 0 is returned upon
280      encountering an EOF, while any unhandled error condition will cause
281      an immediate exit with a return code of 1, instead of entering the
282      debugger.")
283    
284    (defswitch "dynamic-space-size" nil
285      "Specifies the number of megabytes that should be allocated to the
286      heap.  If not specified, a platform- specific default is used.  The
287      actual maximum allowed heap size is platform-specific."
288      "megabytes")
289    
290    (defswitch "lib" nil
291      "A colon-separated list of directories to be used for the library:
292      search-list."
293      "libpath")
294    
295    (defswitch "quiet" nil
296      "Causes Lisp to start up silently, disabling printing of the herald
297      and causing most unnecessary noise, like GC messages,load messages,
298      etc. to be suppressed.")
299    
300    (defswitch "debug-lisp-search" nil
301      "Enables printing of messages indication how CMUCL is searching for
302      its default core file.")
303    
304    (defswitch "unidata" nil
305      "Specify the unidata.bin file to be used."
306      "filename")
307    
308  #+x86  #+x86
309  (defswitch "fpu")  (intl:with-textdomain ("cmucl" "cmucl-x86-vm")
310    (defswitch "fpu" nil
311      "Specifies what kind of floating-point support should be used on x86
312      systems.  If 'x87', Lisp will use the x87 floating-point unit; if
313      'sse2', Lisp uses SSE2 floating-point unit. The default is
314      'auto',which causes Lisp to check to see if SSE2 is available.  If
315      so, then SSE2 is used.  If the SSE2 core file cannot be found,Lisp
316      will fallback to the x87 core, which can run on any machine."
317      "mode"))
318    
319    (defun help-switch-demon (switch)
320      (declare (ignore switch))
321      (format t (intl:gettext "~&Usage: ~A <options>~2%") *command-line-utility-name*)
322      (dolist (s (sort *legal-cmd-line-switches* #'string<
323                       :key #'car))
324        (destructuring-bind (name doc arg)
325            s
326          (format t "    -~A ~@[~A~]~%" name (if arg (intl:gettext arg)))
327          ;; Poor man's formatting of the help string
328          (with-input-from-string (stream (intl:gettext doc))
329            (loop for line = (read-line stream nil nil)
330               while line
331               do (format t "~8T~A~%" line)))))
332      (ext:quit))
333    
334    (defswitch "help" #'help-switch-demon
335      "Print out the command line options and exit")
336    
337    (defswitch "-help" #'help-switch-demon
338      "Same as -help.")

Legend:
Removed from v.1.15.22.1  
changed lines
  Added in v.1.27

  ViewVC Help
Powered by ViewVC 1.1.5