Skip to content
Snippets Groups Projects
Commit 20682d65 authored by ram's avatar ram
Browse files

Initial revision

parent 2b5d4479
No related branches found
No related tags found
No related merge requests found
;;; -*- 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")
This diff is collapsed.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment