mdw@git.distorted.org.uk Git - runlisp/blob - runlisp.lisp

   1 ;;; -*-lisp-*-
   2 ;;;
   3 ;;; Portable command-line tools in Lisp
   4 ;;;
   5 ;;; (c) 2006 Straylight/Edgeware
   6 ;;;
   7
   8 ;;;----- Licensing notice ---------------------------------------------------
   9 ;;;
  10 ;;; This program is free software; you can redistribute it and/or modify
  11 ;;; it under the terms of the GNU General Public License as published by
  12 ;;; the Free Software Foundation; either version 2 of the License, or
  13 ;;; (at your option) any later version.
  14 ;;;
  15 ;;; This program is distributed in the hope that it will be useful,
  16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;;; GNU General Public License for more details.
  19 ;;;
  20 ;;; You should have received a copy of the GNU General Public License
  21 ;;; along with this program; if not, write to the Free Software Foundation,
  22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  23
  24 ;;; Package.
  25 (defpackage #:runlisp
  26   (:use #:common-lisp)
  27   (:export #:*lisp-interpreter* #:*command-line-strings* #:run)
  28   #+cmu (:import-from #:ext #:*command-line-strings*))
  29 (in-package #:runlisp)
  30
  31 ;;; Variables.
  32 (defvar *lisp-interpreter*)
  33 (defvar *command-line-strings* nil)
  34
  35 ;;; Ignore shebang lines.
  36 (set-dispatch-macro-character #\# #\!
  37                               (lambda (stream bang arg)
  38                                 (declare (ignore bang arg))
  39                                 (read-line stream)
  40                                 (values)))
  41
  42 ;;; Shut up, you bastard.
  43 #+cmu (setf ext:*gc-verbose* nil)
  44 (defun suyb ()
  45   (setf *compile-verbose* nil
  46         *load-verbose* nil
  47         *load-print* nil))
  48 #-cmu (suyb)
  49
  50 ;;; Find command-line arguments and run the program.
  51 (defun run ()
  52   #+cmu (suyb)
  53   #+cmu (let ((args lisp::lisp-command-line-list))
  54           (setf *lisp-interpreter* (pop args))
  55           (assert (string= (pop args) "-core"))
  56           (pop args)
  57           (setf *command-line-strings* args))
  58   #+ecl (setf *lisp-interpreter* (ext:argv 0)
  59               *command-line-strings* (loop for i from 1 below (ext:argc)
  60                                            collect (ext:argv i)))
  61   #+clisp (let ((args (coerce (ext:argv) 'list)))
  62             (setf *lisp-interpreter* (car args)
  63                   *command-line-strings* (nthcdr 7 args)))
  64   (let ((*package* (find-package "COMMON-LISP-USER"))
  65         (prog (car *command-line-strings*)))
  66     (handler-case
  67         (progn (load prog) t)
  68       (error (cond)
  69         (format *error-output* "~&~A: ~A~%" (pathname-name prog) cond)
  70         nil))))
  71
  72
  73 ;;;----- That's all, folks --------------------------------------------------