1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
#| rep.jl -- read-eval-print loop
$Id: user.jl,v 1.12 2002/04/14 07:22:39 jsh Exp $
Copyright (C) 1993, 1994 John Harper <john@dcs.warwick.ac.uk>
This file is part of librep.
librep is free software; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
librep is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with librep; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|#
(define-structure user ()
((open rep
rep.regexp
rep.system
rep.io.files
rep.io.processes)
(set-binds))
(defun do-load (name)
(cond ((file-exists-p name)
(load name nil t t))
((string-match "\\.jlc?$" name)
(load name))
(t (require (intern name)))))
(defun parse-options ()
(let (arg)
(condition-case error-data
(while (setq arg (car command-line-args))
(setq command-line-args (cdr command-line-args))
(cond
((member arg '("--call" "-f"))
(setq arg (car command-line-args))
(setq command-line-args (cdr command-line-args))
((symbol-value (read-from-string arg))))
((member arg '("--load" "-l"))
(setq arg (car command-line-args))
(setq command-line-args (cdr command-line-args))
(do-load arg))
((member arg '("-s" "--scheme"))
(setq arg (car command-line-args))
(setq command-line-args (cdr command-line-args))
(setq batch-mode t)
(if (file-exists-p arg)
(structure () (open scheme) (load arg '() 1 1))
(structure () (open scheme) (load arg))))
((string= arg "--check")
(require 'rep.test.framework)
(run-self-tests-and-exit))
((string= arg "--help")
(format standard-error "\
usage: %s [OPTIONS...]
where OPTIONS are any of:
FILE load the Lisp file FILE (from the cwd if possible,
implies --batch mode)
--batch batch mode: process options and exit
--interp interpreted mode: don't load compiled Lisp files
--debug start in the debugger (implies --interp)
--call FUNCTION call the Lisp function FUNCTION
--f FUNCTION
--load FILE load the file of Lisp forms called FILE
-l FILE
--scheme FILE load the file of Scheme forms called FILE
-s FILE (implies --batch mode)
--check run self tests and exit
--version print version details
--no-rc don't load rc or site-init files
--quit, -q terminate the interpreter process\n" program-name)
(throw 'quit 0))
((string= arg "--version")
(format standard-output "rep version %s\n" rep-version)
(throw 'quit 0))
((member arg '("--quit" "-q"))
(throw 'quit 0))
(t
(setq batch-mode t)
(do-load arg))))
(error
(error-handler-function (car error-data) (cdr error-data))
(throw 'quit 1)))))
(setq *user-structure* 'user)
;; Install all autoload hooks.
(load-all "autoload" (lambda (f) (load f nil t)))
;; Do operating-system initialisation
(load-all (concat "os-" (symbol-name operating-system)) t)
;; Load site specific initialisation. Errors here are trapped since
;; they're probably not going to result in an unusable state
(unless (get-command-line-option "--no-rc")
(condition-case error-data
(progn
;; First the site-wide stuff
(load-all "site-init")
;; Now try to interpret the user's startup file, or failing that
;; the default.jl file providing site-wide user options
(or
(load (concat (user-home-directory) ".reprc") t t t)
(load "rep-default" t)))
(error
(default-error-handler (car error-data) (cdr error-data)))))
;; Use all arguments which are left.
(if (get-command-line-option "--debug")
(progn
(require 'rep.lang.debugger)
(call-with-lexical-origins
(lambda ()
(setq interpreted-mode t)
(setq debug-on-error '(bad-arg missing-arg invalid-function
void-value invalid-read-syntax
premature-end-of-stream invalid-lambda-list
invalid-macro invalid-autoload no-catcher
file-error invalid-stream setting-constant
process-error arith-error
assertion-failed check-failed test-failed))
(break)
(parse-options))))
(parse-options))
(unless batch-mode
(format standard-output "rep %s, Copyright (C) 1999-2000 John Harper
rep comes with ABSOLUTELY NO WARRANTY; for details see the file COPYING
Built %s\n" rep-version rep-build-id)
(require 'rep.util.repl)
(repl)))
;; prevent this being opened as a module
nil
|
