chiark - git - mdw - 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 (in-package #:runlisp)
  29
  30 ;;; Variables.
  31 (defvar *lisp-interpreter*)
  32 (defvar *command-line-strings*)
  33
  34 ;;; Ignore shebang lines.
  35 (set-dispatch-macro-character #\# #\!
  36                               (lambda (stream bang arg)
  37                                 (declare (ignore bang arg))
  38                                 (read-line stream)
  39                                 (values)))
  40
  41 ;;; Shut up, you bastard.
  42 #+cmu (setf ext:*gc-verbose* nil)
  43 (setf *compile-verbose* nil
  44       *load-verbose* nil
  45       *load-print* nil)
  46
  47 ;;; Find command-line arguments and run the program.
  48 (defun run ()
  49   #+cmu (let ((args lisp::lisp-command-line-list))
  50           (setf *lisp-interpreter* (pop args))
  51           (assert (string= (pop args) "-core"))
  52           (pop args)
  53           (setf *command-line-strings* args))
  54   #+ecl (setf *lisp-interpreter* (ext:argv 0)
  55               *command-line-strings* (loop for i from 1 below (ext:argc)
  56                                            collect (ext:argv i)))
  57   #+clisp (let ((args (coerce (ext:argv) 'list)))
  58             (setf *lisp-interpreter* (car args)
  59                   *command-line-strings* (nthcdr 7 args)))
  60   (let ((*package* (find-package "COMMON-LISP-USER"))
  61         (prog (car *command-line-strings*)))
  62     (handler-case
  63         (progn (load prog) t)
  64       (error (cond)
  65         (format *error-output* "~&~A: ~A~%" (pathname-name prog) cond)
  66         nil))))
  67
  68
  69 ;;;----- That's all, folks --------------------------------------------------