--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/ilisp/ilisp-dia.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,204 @@
+;;; -*- Mode: Emacs-Lisp -*-
+
+;;; ilisp-dia.el --
+
+;;; This file is part of ILISP.
+;;; Version: 5.7
+;;;
+;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
+;;;               1993, 1994 Ivan Vasquez
+;;;               1994, 1995 Marco Antoniotti and Rick Busdiecker
+;;;
+;;; Other authors' names for which this Copyright notice also holds
+;;; may appear later in this file.
+;;;
+;;; Send mail to 'ilisp-request@lehman.com' to be included in the
+;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP
+;;; mailing list were bugs and improvements are discussed.
+;;;
+;;; ILISP is freely redistributable under the terms found in the file
+;;; COPYING.
+
+
+;;;%%CUSTOMIZING DIALECTS
+;;;
+;;; ILISP is already set up with support for a number of dialects.
+;;; Each dialect has a command NAME that will start an inferior LISP
+;;; of that dialect.  NAME-hook is a hook that will run after the
+;;; default settings for NAME are set up.  NAME-program is the default
+;;; program for NAME. A prefix when starting a dialect will cause you
+;;; to be prompted for the buffer name and the program.  When setting
+;;; something in a hook, you should use the most general dialect that
+;;; makes sense. Dialect definitions and their hooks are executed from
+;;; least specific to most specific.  They will be executed before the
+;;; inferior LISP is started.
+;;;
+;;; These are the currently supported dialects.  The dialects
+;;; are listed so that the indentation correponds to the hierarchical
+;;; relationship between dialects.
+;;; clisp
+;;;   allegro
+;;;   Clisp     (Haible and Stoll)
+;;;   lispworks (Harlequin)
+;;;   lucid
+;;;   cmulisp
+;;;   kcl
+;;;     akcl
+;;;     ibcl
+;;;     ecl
+;;;     gcl
+;;; scheme
+;;;   oaklisp
+;;;   Scheme->C (still "in fieri")
+;;;
+;;; If anyone figures out support for other dialects I would be happy
+;;; to include it in future releases.
+;;;
+;;; ;;; Example of local changes and extensions to ilisp mode
+;;; (setq ilisp-load-hook
+;;;       '(lambda ()
+;;;         ;; Change the allegro lisp program
+;;;         (setq allegro-program "/usr/misc/bin/lisp")
+;;;         ;; Add a new key binding
+;;;         (defkey-ilisp "\C-\M-a" 'arglist-lisp)
+;;;         ;; Define a new subdialect to run on another machine.
+;;;         (defdialect cmlisp "Connection Machine LISP."
+;;;           lucid
+;;;           (setq ilisp-program
+;;;            "rsh power /usr/local/cm/bin/starlisp"))))
+;;;
+;;; ;;; Automatically load a new subdialect
+;;; (autoload 'cmlisp "ilisp" "Run an inferior CM lisp." t)
+;;;
+;;; To define a new dialect use the macro defdialect.  For examples,
+;;; look at the dialect definitions in this file.  There are hooks and
+;;; variables for almost anything that you are likely to need to
+;;; change.  The relationship between dialects is hierarchical with
+;;; the root values being defined in setup-ilisp.  For a new dialect,
+;;; you only need to change the variables that are different than in
+;;; the parent dialect.
+
+
+;;;
+;;; ILISP dialect definition code.
+;;;
+
+;;;%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
+  (if (eq current-prefix-arg 0) (setq current-prefix-arg nil))
+  (setq ilisp-last-buffer (current-buffer)
+	buffer (if current-prefix-arg
+		   (read-from-minibuffer "Buffer: " buffer)
+		   buffer))
+  (funcall setup buffer)
+  (setq ilisp-program
+	(or program 
+	    (if current-prefix-arg
+		(lisp-read-program "Program: " ilisp-program)
+		ilisp-program)))
+  (ilisp buffer setup))
+
+;;;
+(defmacro defdialect (dialect full-name parent &rest body)
+  "Define a new ILISP dialect.  DIALECT is the name of the function to
+invoke the inferior LISP. The hook for that LISP will be called
+DIALECT-hook.  The default program will be DIALECT-program.  FULL-NAME
+is a string that describes the inferior LISP.  PARENT is the name of
+the parent dialect."
+  (let ((setup (read (format "setup-%s" dialect)))
+	(hook (read (format "%s-hook" dialect)))
+	(program (read (format "%s-program" dialect)))
+	(dialects (format "%s" dialect)))
+    (`
+     (progn
+       (defvar (, hook) nil (, (format "*Inferior %s hook." full-name)))
+       (defvar (, program) nil
+	 (, (format "*Inferior %s default program." full-name)))
+       (defun (, setup) (buffer)
+	 (, (format "Set up for interacting with %s." full-name))
+	 (, (read (format "(setup-%s buffer)" parent)))
+	 (,@ body)
+	 (setq ilisp-program (or (, program) ilisp-program)
+	       ilisp-dialect (cons '(, dialect) ilisp-dialect))
+	 (run-hooks '(, (read (format "%s-hook" dialect)))))
+       (defun (, dialect) (&optional buffer program)
+	 (, (format "Create an inferior %s.  With prefix, prompt for buffer and program."
+		   full-name))
+	 (interactive (list nil nil))
+	 (ilisp-start-dialect (or buffer (, dialects)) 
+			      program 
+			      '(, setup))
+	 (setq (, program) ilisp-program))
+       (lisp-add-dialect (, dialects))))))
+
+;;;%%ilisp
+(defun setup-ilisp (buffer)
+  "Set up for interacting with an inferior LISP."
+  (set-buffer (get-buffer-create "*ilisp-send*"))
+  (kill-all-local-variables)
+  (lisp-mode)
+  (setq ilisp-buffer (format "*%s*" buffer))
+  (set-buffer (get-buffer-create ilisp-buffer))
+  (setq major-mode 'ilisp-mode
+	mode-name "ILISP")
+  (lisp-mode-variables t)
+  ;; Set variables to nil
+  (let ((binary ilisp-binary-extension)
+	(init ilisp-init-binary-extension)
+	(vars ilisp-locals))
+    (while (not (null vars))
+      (make-local-variable (car vars))
+      (set (car vars) nil)
+      (setq vars (cdr vars)))
+    ;; Preserve from initialization
+    (if binary (setq ilisp-binary-extension binary))
+    (if init (setq ilisp-init-binary-extension init)))
+  ;; Comint defaults
+  (set-ilisp-input-ring-size 200)
+  (setq comint-prompt-regexp "^[^<> ]*>+:? *"
+
+	comint-get-old-input 'ilisp-get-old-input
+	comint-input-sentinel (function ignore)
+	comint-input-filter 'ilisp-input-filter
+	comint-input-sender 'comint-default-send
+	comint-eol-on-send t)
+  ;; Comint-ipc defaults
+  (setq comint-send-newline t
+	comint-always-scroll nil
+	comint-output-buffer " *Output*"
+	comint-error-buffer " *Error Output*"
+	comint-error-regexp "^\"ILISP:"
+	comint-output-filter (function identity)
+	comint-interrupt-start 'comint-interrupt-start
+	comint-handler 'ilisp-handler
+	comint-update-status 'ilisp-update-status
+	comint-prompt-status 'comint-prompt-status
+	comint-abort-hook 'ilisp-abort-handler)
+  (setq ilisp-use-map ilisp-mode-map
+	ilisp-init-hook '((lambda () (ilisp-init nil nil t)))
+	ilisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)*\\)?\\s *\\'"
+	ilisp-filter-length 3
+	ilisp-error-filter 'ilisp-error-filter
+	ilisp-error-regexp ".*" 
+	ilisp-symbol-delimiters "^ \t\n\('\"#.\)<>"
+	ilisp-program "lisp"
+	ilisp-locator 'lisp-locate-ilisp
+	ilisp-calls-locator 'lisp-locate-calls)
+  (run-hooks 'ilisp-mode-hook))
+
+(defun run-ilisp ()
+  "Create an inferior LISP prompting for dialect.  With prefix, prompt
+for buffer name as well."
+  (interactive)
+  (let ((dialect (completing-read "Dialect: " ilisp-dialects nil t)))
+    (if (not (zerop (length dialect)))
+	(call-interactively (read dialect)))))
+