-(defun process-init-file (specified-pathname default-function)
- (restart-case
- (let ((cookie (list)))
- (flet ((process-stream (stream &optional pathname)
- (loop
- (restart-case
- (handler-bind
- ((error (lambda (e)
- (error "Error during processing of ~
- initialization file ~A:~%~% ~A"
- (or pathname stream) e))))
- (let ((form (read stream nil cookie)))
- (if (eq cookie form)
- (return-from process-init-file nil)
- (eval form))))
- (continue ()
- :report "Ignore and continue processing.")))))
- (if specified-pathname
- (with-open-file (stream (parse-native-namestring specified-pathname)
- :if-does-not-exist nil)
- (if stream
- (process-stream stream (pathname stream))
- (error "The specified init file ~S was not found."
- specified-pathname)))
- (let ((default (funcall default-function)))
- (when default
- (with-open-file (stream (pathname default) :if-does-not-exist nil)
- (when stream
- (process-stream stream (pathname stream)))))))))
- (abort ()
- :report "Skip this initialization file.")))
-
-(defun process-eval-options (eval-strings-or-forms)
- (/show0 "handling --eval options")
- (flet ((process-1 (string-or-form)
- (etypecase string-or-form
- (string
- (multiple-value-bind (expr pos) (read-from-string string-or-form)
- (unless (eq string-or-form
- (read-from-string string-or-form nil string-or-form
- :start pos))
- (error "More than one expression in ~S" string-or-form))
- (eval expr)
- (flush-standard-output-streams)))
- (cons (eval string-or-form) (flush-standard-output-streams)))))
- (restart-case
- (dolist (expr-as-string-or-form eval-strings-or-forms)
- (/show0 "handling one --eval option")
- (restart-case
- (handler-bind
- ((error (lambda (e)
- (error "Error during processing of --eval ~
- option ~S:~%~% ~A"
- expr-as-string-or-form e))))
- (process-1 expr-as-string-or-form))
- (continue ()
- :report "Ignore and continue with next --eval option.")))
- (abort ()
- :report "Skip rest of --eval options."))))
+(defun process-init-file (specified-pathname kind)
+ (multiple-value-bind (context default-function)
+ (ecase kind
+ (:system
+ (values "sysinit" *sysinit-pathname-function*))
+ (:user
+ (values "userinit" *userinit-pathname-function*)))
+ (flet ((process-stream (stream pathname)
+ (with-simple-restart (abort "Skip rest of ~A file ~S."
+ context (native-namestring pathname))
+ (loop
+ (with-simple-restart
+ (continue "Ignore error and continue processing ~A file ~S."
+ context (native-namestring pathname))
+ (let ((form (read stream nil stream)))
+ (if (eq stream form)
+ (return-from process-init-file nil)
+ (eval form))))))))
+ (if specified-pathname
+ (with-open-file (stream (parse-native-namestring specified-pathname)
+ :if-does-not-exist nil)
+ (if stream
+ (process-stream stream (pathname stream))
+ (cerror "Ignore missing init file"
+ "The specified ~A file ~A was not found."
+ context specified-pathname)))
+ (let ((default (funcall default-function)))
+ (when default
+ (with-open-file (stream (pathname default) :if-does-not-exist nil)
+ (when stream
+ (process-stream stream (pathname stream))))))))))
+
+(defun process-eval/load-options (options)
+ (/show0 "handling --eval and --load options")
+ (flet ((process-1 (cons)
+ (destructuring-bind (opt . value) cons
+ (ecase opt
+ (:eval
+ (with-simple-restart (continue "Ignore runtime option --eval ~S."
+ value)
+ (multiple-value-bind (expr pos) (read-from-string value)
+ (if (eq value (read-from-string value nil value :start pos))
+ (eval expr)
+ (error "Multiple expressions in --eval option: ~S"
+ value)))))
+ (:load
+ (with-simple-restart (continue "Ignore runtime option --load ~S."
+ value)
+ (load (native-pathname value))))))
+ (flush-standard-output-streams)))
+ (with-simple-restart (abort "Skip rest of --eval and --load options.")
+ (dolist (option options)
+ (process-1 option)))))
+
+;;; Skips past the shebang line on stream, if any.
+(defun maybe-skip-shebang-line (stream)
+ (let ((p (file-position stream)))
+ (flet ((next () (read-byte stream nil)))
+ (unwind-protect
+ (when (and (eq (next) (char-code #\#))
+ (eq (next) (char-code #\!)))
+ (setf p nil)
+ (loop for x = (next)
+ until (or (not x) (eq x (char-code #\newline)))))
+ (when p
+ (file-position stream p))))
+ t))
+
+(defun process-script (script)
+ (let ((pathname (native-pathname script)))
+ (handling-end-of-the-world
+ (with-open-file (f pathname :element-type :default)
+ (maybe-skip-shebang-line f)
+ (load f :verbose nil :print nil)
+ (quit)))))