I've fixed and added a few things in ILISP.
- Made arglist and source-file work for cmulisp.
- Made it possible to transpose the source file names of the
system functions to a local directory. e.g. Meta-. on 'eq'
will bring up /mydir/CMU-CL/code/pred.lisp instead of barfing
on /afs/cs.cmu.edu/...etc.../pred.lisp
Specify the variables cmu-cl-source-filename and
local-cmu-cl-source-filename in cmulisp.lisp.
- Added a hack that strips out the unneeded part of an
ange-ftp filename as in ·····@bar:/directory/file". So that
you can have compilations still work from ILISP in a local
emacs when you run a remote lisp session and visit remote
files via ange-ftp.
I am also considering forming an ilisp mailing list. Send me mail if
you are interested.
Apply these diff -e scripts (with patch) to ilisp.el and cmulisp.el
Note: I updated cmulisp's binary-extension to sparcf from fasl. You
may not want this.
ilisp.el.patch
------------------------------ Cut Here ------------------------------
2917c
;(defdialect cscheme "C Scheme"
.
2906c
ilisp-binary-extension "sparcf"))
.
2591,2601c
;; Ivan's hack for ange-ftp pathnames...
(let ((file-name
(if (string-match ·····@.*:" file-name)
(substring file-name (match-end 0))
file-name)))
(ilisp-send
(format (ilisp-value 'ilisp-compile-file-command) file-name
(or extension (ilisp-value 'ilisp-binary-extension)))
(concat "Compile " file-name) 'compile
t)))
;;;%Dialects
(defun lisp-add-dialect (dialect)
"Add DIALECT as a supported ILISP dialect."
(if (not (lisp-memk dialect ilisp-dialects 'car))
(setq ilisp-dialects
(cons (list dialect) ilisp-dialects))))
;;;
(defun ilisp-start-dialect (buffer program setup)
;; Allow dialects to be started from command line
.
2582,2586c
;; Ivan's hack for ange-ftp pathnames...
(let ((file-name
(if (string-match ·····@.*:" file-name)
(substring file-name (match-end 0))
file-name)))
(comint-sender
(ilisp-process)
(format (ilisp-value 'ilisp-load-command) file-name))
(message "Loading %s" file-name))))
;;;
(defun compile-file-lisp (file-name &optional extension)
"Compile a Lisp file in the current inferior LISP and go there."
(interactive (comint-get-source
"Compile Lisp file: " lisp-prev-l/c-dir/file
lisp-source-modes nil))
.
------------------------------ Cut Here ------------------------------
cmulisp.lisp.patch
------------------------------ Cut Here ------------------------------
123,135c
(let* ((x (ilisp:ilisp-find-symbol symbol package))
(fun (symbol-function x)))
(when (and fun (compiled-function-p fun))
;; Added check for closure-functions Ivan Fri Jan 15 19:07:18 1993
(when (and (= (lisp::get-type fun) #.vm:closure-header-type)
(not (eval:interpreted-function-p fun)))
(setq fun (lisp::%closure-function fun)))
(let ((info (kernel:code-debug-info (kernel:function-code-header fun))))
(when info
(let ((sources (c::compiled-debug-info-source info)))
(when sources
(dolist (source sources)
(let ((name (c::debug-source-name source)))
(when (eq (c::debug-source-from source) :file)
(when (and transpose-cmu-cl-source-filename
(> (length name)
(length cmu-cl-source-filename))
(string=
(subseq name 0
(length cmu-cl-source-filename))
cmu-cl-source-filename))
(setq name
(concatenate
'string transpose-cmu-cl-source-filename
(subseq name
(length cmu-cl-source-filename)))))
(print (namestring name)))))
t))))))))
;;; (let* ((compiler-string
;;; (%primitive header-ref (symbol-function fun)
;;; %function-defined-from-slot))
;;; (def-string
;;; (subseq
;;; compiler-string 0 (position #\space compiler-string))))
;;; (if (string= def-string "Lisp") nil
;;; (progn (print def-string)
;;; t)
;;; ))))))
.
119c
(defparameter cmu-cl-source-filename
"/afs/cs.cmu.edu/project/clisp/src/16/")
(defparameter local-cmu-cl-source-filename
"/usr/local/utils/CMU-CL/")
.
102,113c
(lisp::%function-header-arglist fun))
((eval:interpreted-function-p fun)
(eval:interpreted-function-arglist fun))
;; this never happens.
;;((eq (car fun) '%compiled-closure%)
;;(describe-function-compiled (third x)))
;;((desc-lexical-closure-p fun)
;;(cadadr fun))
(t (error "Unknown type of function"))))))))
.
98c
(fun (symbol-function x)))
;; Added check for closure-functions Ivan Fri Jan 15 19:07:18 1993
(when (and (= (lisp::get-type fun) #.vm:closure-header-type)
(not (eval:interpreted-function-p fun)))
(setq fun (lisp::%closure-function fun)))
.
94c
.
91d
89a
(export '(arglist source-file))
.
------------------------------ Cut Here ------------------------------