Re: cormanlisp patches for 5.11

--- ACKNOWLEDGMENTS.orig	Fri Mar  1 17:46:19 2002
+++ ACKNOWLEDGMENTS	Tue May 28 10:32:47 2002
@@ -51,6 +51,7 @@
 Larry Stead,
 Jason Trenouth,
 Christof Ullwer,
+Reini Urban,
 Bjorn Victor,
 Edmund Weitz,
 Fred White,
--- ChangeLog.orig	Fri May 24 18:40:34 2002
+++ ChangeLog	Tue May 28 11:47:51 2002
@@ -1,3 +1,30 @@
+2002-05-28  Reini Urban  <[email protected]>
+
+	Corman Lisp support, improved cygwin support, ild easy-menu:
+	
+	* cormanlisp.lisp, ilisp-ccl.el: new
+	
+	* ilisp-hi.el (file-name-hack): new function. Combined Ivan's 
+	ange-ftp hack and the cygwin => w32 path conversion.
+
+	* cl-ilisp-lisp (ilisp-w32-fix-filenames): new function. Similar to 
+	file-name-hack on the lisp side. Converts backslashes to forward slashes 
+	also. Some minor corman fixes.
+
+	* ilisp-cl-easy-menu.el ('ilisp-ild-easy-menu): added. 
+	Insert "Debug" Menu if ilisp-*enable-ild-support-p*. Enable the commands 
+	only if inside the debugging loop.
+	(ilisp-ild-p): added
+	(ilisp-insert-menu): added
+	(ilisp-redefine-menu): added
+	'ilisp-cl-easy-menu: changed to defvar
+
+	* ACKNOWLEDGMENTS: added myself.
+	
+	* Makefile (LoadFiles): added ilisp-ccl.elc 
+
+	* ilisp.el: added (load "ilisp-ccl")
+
 2002-05-24  Matthias Koeppe  <[email protected]>
 
 	* guile-ilisp.scm (ilisp-in-package): Fix process-use-modules call.
--- Makefile.orig	Fri Jan 25 13:48:33 2002
+++ Makefile	Tue May 28 11:42:27 2002
@@ -15,7 +15,7 @@
 #==============================================================================
 # Various Variables
 
-Version = 5.11.1
+Version = 5.12
 
 # Use whichever you like most
 #EMACS = xemacs
@@ -62,7 +62,7 @@
  ilisp-xfr.elc ilisp-hi.elc ilisp-aut.elc \
  ilisp-cl.elc ilisp-cmu.elc ilisp-sbcl.elc ilisp-cl-easy-menu.elc\
  ilisp-acl.elc ilisp-kcl.elc ilisp-luc.elc ilisp-sch.elc ilisp-hlw.elc \
- ilisp-xls.elc ilisp-chs.elc ilisp-openmcl.elc
+ ilisp-xls.elc ilisp-chs.elc ilisp-openmcl.elc ilisp-ccl.elc 
 
 
 DocFiles = docs/Makefile \
--- cl-ilisp.lisp.orig	Tue Mar 26 11:41:04 2002
+++ cl-ilisp.lisp	Tue May 28 11:23:51 2002
@@ -147,7 +147,7 @@
 
 ;; MNA: ecl (ecls-0.5) still had special-form-p in COMMON-LISP,
 ;; which produced an error, when redefined.
-#+(and :ANSI-CL (not :ecl))
+#+(and (or :CORMANLISP :ANSI-CL) (not :ecl))
 (defun special-form-p (symbol)
   "Backward compatibility for non ANSI CL's."
   (special-operator-p symbol))
@@ -295,6 +295,22 @@
     (read-from-string form)))
 |#
 
+;;; 2000-09-29 11:28:36 rurban
+;;; I needed this for Xemacs/cmd.exe/cormanlisp which swallows all my backslashes.
+;;; Slashes do work fine on NT.
+(defun ilisp-w32-fix-filename (filename)
+  "Pathslash hack: replace all '\\' by '/' in filenames.
+Convert cygwin paths also.
+This will only work on Microsoft NT, not on a Win95 based OS."
+  ;; (setq filename "r:\\gnu\\XEMACS~1.35\\lisp\\replace.elc")
+  ;; (setq filename "/cygdrive/r/xx") => "r:/"
+  (do ((pos (position #\\ filename) (position #\\ filename)))
+      ((null pos) filename)
+    (setf (aref filename pos) #\/))
+  (if (string-equal "/cygdrive/" (subseq filename 0 10))
+      (setf filename (concatenate 'string (subseq filename 10 11) ":" (subseq filename 11)))
+      filename))
+
 ;;;
 (defun ilisp-eval (form package filename)
   "Evaluate FORM in PACKAGE recording FILENAME as the source file."
@@ -307,6 +323,8 @@
 	  (if (and at-location colon-location)
 	      (subseq filename (1+ colon-location))
 	      filename))
+	 #+:cormanlisp
+	 (filename (ilisp-w32-fix-filename filename))
 	 (*package* (ilisp-find-package package))
 	 #+allegro (excl::*source-pathname* filename)
 	 #+allegro (excl::*redefinition-warnings* nil)
@@ -730,7 +748,7 @@
        (if results (prin1 results) (princ "()"))
        nil))))
 
-
+#-:cormanlisp
 (eval-when (load eval)
   (when
       #+(and :CMU (or :CMU17 :CMU18))
--- cormanlisp.lisp.orig	Tue May 21 11:11:33 2002
+++ cormanlisp.lisp	Fri May 17 20:58:14 2002
@@ -0,0 +1,143 @@
+;;; -*- Mode: Lisp; tab-width: 4 -*-
+;;; cormanlisp.lisp --
+
+;;; This file is (not yet) part of ILISP.
+;;; Version: 5.8 - 5.10
+;;;
+;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
+;;;               1993, 1994 Ivan Vasquez
+;;;               1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
+;;;               1996 Marco Antoniotti and Rick Campbell
+;;;		  	      2000 Reini Urban
+;;;
+;;; Other authors' names for which this Copyright notice also holds
+;;; may appear later in this file.
+;;;
+;;; ILISP is freely redistributable under the terms found in the file
+;;; COPYING.
+
+;;;
+;;; Cormanlisp initializations
+;;; Author: Reini Urban <[email protected]>
+;;;
+(in-package "ILISP")
+
+(defun ilisp-source-files (symbol package type)
+  "Print each file for PACKAGE:SYMBOL's TYPE definition on a line and
+return T if successful."
+  (declare (ignore type))
+  (ilisp-errors
+   (let* ((symbol (ilisp-find-symbol symbol package))
+	  (type t)
+	  ;;(type (if (equal type "any") t (ilisp-find-symbol type "keyword")))
+	  (paths (when symbol (debug::function-source-file symbol))))
+     (if paths
+	 (progn
+	   (if (eq type t)
+	       (dolist (path (remove-duplicates paths
+						:key #'cdr :test #'equal))
+		 (print (namestring (cdr path))))
+	       (print (namestring paths)))
+	   t)
+	 nil))))
+
+(export '(ilisp-source-files))
+
+;;; ILISP Patches for cormanlisp <= 2.0
+
+(in-package :common-lisp)
+
+(defun inspect (symbol)
+  (describe symbol))
+
+;; not really needed with my cl-ilisp.lisp patch, but for legacy sake
+(defun special-form-p (symbol)
+  (special-operator-p symbol))
+
+(unless (fboundp 'compile-file-pathname)
+
+(defvar fasl-file-extension ".fasl")
+;;;
+;;; Common Lisp COMPILE-FILE-PATHNAME function.
+;;;
+;;; CLtL2: "If an implementation supports additional keyword arguments to
+;;; compile-file, compile-file-pathname must accept the same arguments."
+;;;
+(defun compile-file-pathname (input-file &key 
+                                         (output-file nil)
+                                         (verbose *compile-verbose*)
+                                         (print *compile-print*)
+                                         (external-format :default))
+  (create-pathname-from-string
+   (compile-file-name  (namestring (pathname input-file))
+					  :output-file output-file
+					  :verbose     verbose
+					  :print       print
+					  :external-format external-format)))
+
+(defun compile-file-name (input-file &key 
+									 (output-file nil)
+									 (verbose *compile-verbose*)
+									 (print *compile-print*)
+									 (external-format :default))
+  "Returns the compiled filename string for the input-file string"
+  (declare (ignore verbose external-format print))
+  (if (null output-file)
+      (if (string-equal
+           (subseq input-file 
+                   (- (length input-file)(length lisp-file-extension))
+                   (length input-file))
+           lisp-file-extension)
+          (concatenate 'string 
+                       (subseq input-file 
+                               0
+                               (- (length input-file)
+								  (length lisp-file-extension)))
+                       fasl-file-extension)
+        (concatenate 'string input-file fasl-file-extension))
+     (namestring (pathname output-file))))
+
+) ; eof compile-file-pathname patch
+
+(unless (fboundp 'readtable-case)
+  
+;;;
+;;; Common Lisp READTABLE-CASE accessor
+;;;
+;;; Note: at booting check-type,warn,defun setf are not defined
+;;;
+(defun readtable-case (readtbl)
+  (if (macro-function 'check-type)	; booting
+	  (check-type readtbl readtable)
+	;; else
+    (if (not (readtablep readtbl))
+		(error "Argument is no valid readtable: ~A" readtbl)))
+  (uref readtbl readtable-case-offset))
+
+(defun set-readtable-case (readtbl value)
+  "For compatibility only. All values except :UPCASE are ignored."
+  (let ((valid-case '(:upcase))
+		(ignored-case '(:downcase :preserve :invert)))
+	(if (macro-function 'check-type)	; booting
+		(progn
+		  (check-type readtbl readtable)
+		  (check-type value symbol)))
+	(cond 
+	 ((member value valid-case)
+	  (setf (uref readtbl readtable-case-offset) value))
+	 ((member value ignored-case)
+	  (error "SET-READTABLE-CASE: only :UPCASE supported: ~A" 
+			value))
+	 (T
+	  (error "Argument is no valid readtable-case: ~A, expected ~A"
+			 value valid-case)))))
+
+;;; bootstrapping
+(set-readtable-case *readtable* ':upcase)
+(set-readtable-case *common-lisp-readtable* ':upcase)
+
+(defsetf readtable-case set-readtable-case)
+
+)  ; eof readtable-case patch
+
+(in-package :ilisp)
--- ilisp-ccl.el.orig	Tue May 21 11:13:49 2002
+++ ilisp-ccl.el	Tue May 28 11:08:59 2002
@@ -0,0 +1,120 @@
+;;; -*- Mode: Emacs-Lisp -*-
+
+;;; ilisp-ccl.el --
+
+;;; This file is part of ILISP.
+;;; Version: 5.12
+;;;
+;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
+;;;               1993, 1994 Ivan Vasquez
+;;;               1994, 1995, 1996 Marco Antoniotti and Rick Busdiecker
+;;;               1996, 1997, 1998, 1999 Marco Antoniotti and Rick Campbell
+;;;		  2000 Reini Urban
+;;;
+;;; Other authors' names for which this Copyright notice also holds
+;;; may appear later in this file.
+;;;
+;;; Send mail to '[email protected]' to be included in the
+;;; ILISP mailing list. '[email protected]' is the general ILISP
+;;; mailing list were bugs and improvements are discussed.
+;;;
+;;; ILISP is freely redistributable under the terms found in the file
+;;; COPYING.
+
+;;;
+;;; Dialect definition for Corman Common Lisp by Roger Corman 
+;;; Since 1.4 (fixed with 1.41) there is a debugger with corman.
+
+(require 'cl)
+
+;;; cormanlisp --
+;;;
+;;; Notes:
+;;; 2000-09-08 16:01:20 rurban
+;;;   created, based on chs and acl
+;;; Problems: 
+;;;  * win32 pathdelims get lost on C-c l, but a manual load works.
+;;;  * subsequent invocations load the next lisp (clisp in my case) 
+;;;    instead of corman.
+
+; Hint:
+; Best is to load cl-ilisp.lisp, ilisp-pkg.lisp and cormanlisp.lisp 
+; with all required corman patches into cormanlisp at first and save 
+; the image.
+;
+; On cygwin (X)Emacs we have to convert the filenames passed to the lisp.
+; ilisp-hi.el:   file-name-hack for elisp
+; cl-ilisp.lisp: ilisp-w32-fix-filenames for lisp
+; ilisp-cl-easy-menu.el
+;   added a Debugger menu section for XEmacs (easy-menu)
+
+; Old ILISP Patches for 5.11:
+;   http://xarch.tu-graz.ac.at/autocad/lisp/cormanlisp/ilisp-ccl-5.11.zip
+; Cormanlisp fixes: (required for at least CCL 1.5)
+;   http://xarch.tu-graz.ac.at/autocad/lisp/cormanlisp/ccl-1.5-patches.zip
+
+; Todo: custom vars for these.
+; We really should query the registry. The dll is registered there, 
+; so we would also know the version.
+; A XEmacs dynamic w32reg emodule is almost ready:
+;   http://xarch.tu-graz.ac.at/autocad/lsp_tools/ntemacs/emodules/w32reg/w32reg.c
+
+; define these in ~/.ilisp
+;(setq *cormanlisp-dir* "P:/CORMAN~1/CORMAN~1.5/")
+(unless (boundp '*cormanlisp-dir*)
+  (setq *cormanlisp-dir* "C:/PROGRAM~1/CORMAN~1/CORMAN~1.5/"))
+
+(unless (boundp 'cormanlisp-program)
+  (setq cormanlisp-program
+	(concatenate 'string *cormanlisp-dir* "clconsole.exe" 
+		     " -image " *cormanlisp-dir* "CormanLisp.img")))
+
+;(defvar ilisp-cormanlisp-init-file
+;	(concatenate 'string *cormanlisp-dir* "init.lisp"))
+(defvar ilisp-cormanlisp-init-file "cormanlisp.lisp")
+
+(defdialect cormanlisp "CormanLisp" common-lisp
+  (ilisp-load-init 'ilisp-package-kludge ilisp-cl-ilisp-package-file)
+  (ilisp-load-init 'common-lisp ilisp-cl-ilisp-init-file)
+  (ilisp-load-init 'cormanlisp ilisp-cormanlisp-init-file)
+  (setq
+     ilisp-error-regexp  "\\(ILISP:[^\n]*\\)\\|\\(^;;; 1   Abort to top level.\\)"
+     ilisp-find-source-command  "(ILISP:ilisp-source-files \"%s\" \"%s\" \"%s\")"
+     ilisp-reset "(debug::debugger-continue)"
+     ilisp-block-command "(progn %s)"
+     ;; cl overrides
+     ilisp-inspect-command nil		 ; no inspector
+;     ilisp-binary-extension nil ; "fasl" ; avoid compilation
+;     ilisp-compile-file-command nil      ; avoid compilation
+
+;     ilisp-*use-frame-for-output* nil	  ; this should go to .ilisp
+;     ilisp-bindings-*bind-space-p* nil    ; this should go to .ilisp
+     ;; default
+     comint-prompt-regexp "^?*"
+     ;; comint-prompt-regexp "^\\([0-9]+\\. Break \\[[0-9]+\\]> \\|^[^>]*> \\)"
+     comint-fix-error ":C 1"
+     comint-continue ":C"
+   )
+
+  ;; ILD Support. NIL values mean that more work is needed or that the
+  ;; particular command is not available
+
+  (setq ild-abort-string ":QUIT"
+	ild-continue-string ":C 1"
+	ild-next-string ":NEXT"
+	ild-next-string-arg nil
+	ild-previous-string ":PREVIOUS"
+	ild-previous-string-arg nil
+	ild-top-string ":TOP"
+	ild-bottom-string ":BOTTOM"
+	ild-backtrace-string ":BACKTRACE"
+	ild-locals-string nil
+	ild-local-string-arg nil
+	;ild-return-string "return"
+	;ild-retry-string "redo"
+	;ild-trap-on-exit-string "break+"
+	))
+
+(provide 'ilisp-ccl)
+
+;;; end of file -- ilisp-chs.el --
--- ilisp-cl-easy-menu.el.orig	Thu Jan 31 16:56:45 2002
+++ ilisp-cl-easy-menu.el	Tue May 28 11:27:54 2002
@@ -78,7 +78,7 @@
 	     (not (featurep 'hyperspec)))
     (load-library "extra/hyperspec")))
 
-(defconst ilisp-cl-easy-menu
+(defvar ilisp-cl-easy-menu
   `("Ilisp"
     [ "Load File" load-file-lisp t ]
     [ "Run Ilisp" run-ilisp t ]
@@ -172,6 +172,47 @@
     )
   )
 
+;;; insert "Debug" Menu if ilisp-*enable-ild-support-p*
+;;; enable the commands only if inside the debugging loop
+;;;
+;;; 2000-10-10 17:34:05 rurban
+(defconst ilisp-ild-easy-menu
+    `("Debug"
+     [ "Abort" 	  ild-abort 	(ilisp-ild-p) ]
+     [ "Continue" ild-continue 	(ilisp-ild-p) ]
+     [ "Next" 	  ild-next 	(ilisp-ild-p) ]
+     [ "Previous" ild-previous 	(ilisp-ild-p) ]
+     [ "Top" 	  ild-top 	(ilisp-ild-p) ]
+     [ "Bottom"   ild-bottom 	(ilisp-ild-p) ]
+     [ "Backtrace" ild-backtrace (ilisp-ild-p) ]
+     [ "Locals"   ild-locals 	(ilisp-ild-p) ]
+     [ "Local"    ild-local 	(ilisp-ild-p) ]
+     [ "Return"   ild-return 	(ilisp-ild-p) ]
+     [ "Retry"    ild-retry 	(ilisp-ild-p) ]
+     [ "Trap on exit" ild-trap-on-exit (ilisp-ild-p) ]
+     "--"
+     [ "Fast lisp" fast-lisp t ]
+     [ "Slow lisp" slow-lisp t ]
+     )
+    )
+
+(defun ilisp-ild-p ()
+  t)
+
+(defun ilisp-insert-menu (menu where what)
+  "Insert WHAT into MENU after WHERE"
+  (if (position what menu)
+      menu
+    (let ((i (position (assoc where menu) menu)))
+      (setq i    (1+ i)
+	    menu (append (butlast menu (- (length menu) i))
+			 (list what)
+			 (nthcdr i menu))))))
+  
+(if ilisp-*enable-ild-support-p*
+  (setq ilisp-cl-easy-menu 
+	(ilisp-insert-menu ilisp-cl-easy-menu "Misc" ilisp-ild-easy-menu)))
+
 ;;; ilisp-update-menu
 ;;;
 ;;; 19990818 Marco Antoniotti
@@ -179,6 +220,14 @@
 (defun ilisp-update-menu (status)
   ;; Backward compatibility with old keymap based menus.
   ;; A no-op for the time being.
+  )
+
+(defun ilisp-redefine-menu ()
+  (easy-menu-remove ilisp-cl-easy-menu)
+  (easy-menu-define menubar-ilisp ilisp-mode-map 
+		    "Ilisp commands"
+		    ilisp-cl-easy-menu)
+  (easy-menu-add ilisp-cl-easy-menu 'ilisp-mode-map)
   )
 
 (provide 'ilisp-cl-easy-menu)
--- ilisp-hi.el.orig	Thu Apr 11 09:49:36 2002
+++ ilisp-hi.el	Tue May 28 10:20:23 2002
@@ -216,6 +216,21 @@
 	 'call)
        t)))
 
+;;; 2002-05-20 09:38:07 rurban
+;;; Ivan's ange-ftp hack: "/user@server:~/xx.lisp" => "~/xx.lisp"  
+;;; Reini's cygwin hack: "/cygdrive/r/xx.lisp"     => "r:/xx.lisp"
+(defun file-name-hack (file-name)
+  "Strip ange-ftp and cygwin pathnames prefixes for the native local lisp"
+  (cond ((string-match "/.*?@.*:" file-name)
+	 (substring file-name (match-end 0)))
+	((not (eq system-type 'cygwin32)) file-name) ; verified on XEmacs
+	;; assume cygwin clisp on cygwin (X)Emacs
+	((eq ilisp-dialect 'clisp-hs) file-name)
+	;; => w32 path for non-cygwin lisps only.
+	((string-equal "/cygdrive/" (subseq file-name 0 10))
+	 (concat (subseq file-name 10 11) ":" (subseq file-name 11)))
+	(t file-name)))
+
 ;;;
 (defun compile-file-lisp (file-name &optional extension)
   "Compile a Lisp file in the current inferior LISP and go there."
@@ -226,11 +241,7 @@
   (setq lisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
 				     (file-name-nondirectory file-name)))
   (ilisp-init t)
-  ;; Ivan's hack for ange-ftp pathnames...
-  (let ((file-name
-	 (if (string-match "/.*?@.*:" file-name)
-	     (substring file-name (match-end 0))
-	   file-name)))
+  (let ((file-name (file-name-hack file-name)))
     (ilisp-send
      (format (ilisp-value 'ilisp-compile-file-command) file-name
 	     (or extension (ilisp-value 'ilisp-binary-extension)))
@@ -570,16 +581,11 @@
         (when (file-readable-p binary)
           (setq file-name binary))))
     (switch-to-lisp t t)
-    ;; Ivan's hack for ange-ftp pathnames...
-    (let ((file-name
-           (if (string-match "/.*?@.*:" file-name)
-               (substring file-name (match-end 0))
-             file-name)))
+    (let ((file-name (file-name-hack file-name)))
       (comint-sender
        (ilisp-process)
        (format (ilisp-value 'ilisp-load-command) file-name))
       (message "Loading %s" file-name))))
-
 
 
 ;;;%Source
--- ilisp-mak.el.orig	Thu May 23 22:40:41 2002
+++ ilisp-mak.el	Tue May 28 11:25:44 2002
@@ -100,6 +100,7 @@
 
 		   ;; Dialects.
 		   "ilisp-cl"
+		   "ilisp-ccl"
 		   "ilisp-cmu"
 		   "ilisp-sbcl"
 		   "ilisp-chs"
--- ilisp-snd.el.orig	Thu Apr 11 09:49:36 2002
+++ ilisp-snd.el	Tue May 28 09:59:58 2002
@@ -456,9 +456,7 @@
                     (if (file-newer-than-file-p binary source)
                       binary
                       source))))
-            (ilisp-load-or-send
-             load-file)))
-                             
+            (ilisp-load-or-send (file-name-hack load-file))))
         (comint-send-code (ilisp-process)
                           'ilisp-done-init)
         (setq done t))                         
--- ilisp.el.orig	Thu May 23 22:38:06 2002
+++ ilisp.el	Tue May 28 11:47:46 2002
@@ -173,6 +173,7 @@
   (load "ilisp-luc")
   (load "ilisp-sch")
   (load "ilisp-openmcl")
+  (load "ilisp-ccl")
 
   )
 
--- ilisp.emacs.orig	Mon Dec 10 15:23:55 2001
+++ ilisp.emacs	Tue May 28 11:37:17 2002
@@ -55,6 +55,9 @@
 ;; Franz
 (autoload 'allegro     "ilisp" "Inferior Allegro Common Lisp." t)
 
+;; Corman
+(autoload 'cormanlisp  "ilisp" "Inferior Corman Common Lisp." t)
+
 ;; Lucid
 ; (autoload 'lucid     "ilisp" "Inferior Lucid Common Lisp." t)
 
@@ -108,6 +111,11 @@
 ; (setq lucid-program "/usr/misc/.lucid/bin/lisp")
 
 (setq clisp-hs-program "clisp -I")
+
+;(setq *cormanlisp-dir* "C:\\CORMAN~1\\CORMAN~1.5\\")
+;(setq cormanlisp-program
+;      (concat *cormanlisp-dir* "clconsole.exe" 
+;	       " -image " *cormanlisp-dir* "CormanLisp.img"))
 
 ; (setq lispworks-program
 ;       "/somewhere/in/the/directory/tree/lispworks")