Commit | Line | Data |
---|---|---|
c8f068d2 MW |
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 -------------------------------------------------- |