Source

ilisp / ilisp-sbcl.el

Diff from to

ilisp-sbcl.el

 ;;; $Id$
 
 ;;;%%%Steel Bank Common Lisp
-
+    
 (defvar ilisp-sbcl-init-file
   ;; Note: The init file source extension (".lisp") needs to be
   ;; present in the filename, otherwise ILISP-LOAD-OR-SEND gets
   ;; decide where to append the compiled-file extension.
   "sbcl")
 
+;;; dummy sbcl-check-prompt
+;; the real function-definition is set later.
+(defun sbcl-check-prompt (old new)
+  nil)
+
+;;; sbcl-check-prompt function for SBCL-0.6.x or earlier.
+;;;
 ;;; WHN threatens to change the format of the break prompt one day soon, 
 ;;; but as of 0.6.12.21 this hasn't happened yet
-(defun sbcl-check-prompt (old new)
+(defun sbcl-check-prompt-sbcl<07 (old new)
   "Compare the break level printed at the beginning of the prompt."
   (let* ((was-in-break (and old (string-match "]+" old)))
- 	 (old-level (if was-in-break
- 			(- (match-end 0) (match-beginning 0))
- 			0))
- 	 (is-in-break (string-match "]+" new))
- 	 (new-level (if is-in-break
- 			(- (match-end 0) (match-beginning 0))
- 			0)))
+         (old-level (if was-in-break
+                      (- (match-end 0) (match-beginning 0))
+                      0))
+         (is-in-break (string-match "]+" new))
+         (new-level (if is-in-break
+                      (- (match-end 0) (match-beginning 0))
+                      0)))
     (<= new-level old-level)))
 
+;;; sbcl-check-prompt function for SBCL-0.7.x or later (probably).
+;;;
+;;; WHN not only threatened to change the format of the break prompt,
+;;; but now he has done it, in sbcl 0.7, as it seems.
+;;; So, we should finally take care of that.
+
+(defun match-and-extract (prompt)
+  (let ((level-1-regexp "]")
+        (level-2-n-regexp "\\(\\[[0-9]+\\]\\)"))
+    (let* ((level-2-p
+             (string-match level-2-n-regexp prompt))
+           (level-1-p
+             (unless level-2-p
+               (string-match level-1-regexp
+                             prompt)))
+           (no-level (unless (or level-1-p level-2-p) 0)))
+      (cond (level-1-p 1)
+            (level-2-p
+              ;; level 2 or greater,
+              ;; e.g. x[y] prompt
+              (string-to-int
+               (subseq prompt (1+ (match-beginning 0)) 
+                       (1- (match-end 0)))))
+            (t
+              no-level)))))
+    
+(defun sbcl-check-prompt-sbcl>=07 (old new)
+  "Compare the break level printed at the beginning of the prompt."
+  ;; SBCL has the new break prompt sequence such as
+  ;; 0] -> 0[2].
+  (let* ((old-level (if old
+                      (match-and-extract old)
+                      0))
+         (new-level (if new
+                      (match-and-extract new)
+                      0)))
+    (<= new-level old-level)))
+
+;;; SBCL Versioning stuff - e.g. distinguishing between some versions ...
+
+(defvar ilisp-*sbcl<07-version* nil)
+;; Distinguish SBCL-0.6.x (or earlier) vs. SBCL-0.7.x (and probably later).
+
+(defvar ilisp-*determine-version-lisp-string* 
+  "(find-package :sb-eval)") ; in SBCL-0.7.x an Interpreter didn't exist in the
+                             ; SB-EVAL package any more.
+
+(defun set-determined-sbcl-version ()
+  ;; do we have a SBCL-version less than 0.7.x?
+  (let ((result (car (comint-send
+                      (ilisp-process) ilisp-*determine-version-lisp-string*
+                      t t 'init-sbcl-version nil nil))))
+    (setq ilisp-*sbcl<07-version* (not (string-match "[\n]*NIL[\n]*" result)))))
+
+(defun sbcl-ilisp-customize ()
+  (fset 'sbcl-check-prompt
+        (if ilisp-*sbcl<07-version*
+          (function sbcl-check-prompt-sbcl<07)
+          (function sbcl-check-prompt-sbcl>=07)))
+  
+  (set-ilisp-value 'comint-prompt-regexp
+                   (if ilisp-*sbcl<07-version*
+                     ;; old comint-prompt-regexp (sbcl-0.6 or earlier).
+                     "^\\([0-9]+\\]+\\|\\*\\) "
+                     ;; new comint-prompt-regexp for sbcl-0.7 (and maybe later).
+                     "^\\([0-9]+\\]+\\|[0-9]+\\[[0-9]+\\]\\|\\*\\) ")))
+
+(defun sbcl-version-hook-fun ()
+  (when (equal (process-name (ilisp-process)) "sbcl")
+    ;; sets ILISP-*SBCL<07-VERSION*
+    (set-determined-sbcl-version)
+    (sbcl-ilisp-customize)))
+
 ;;;
 (defdialect sbcl "Steel Bank Common LISP"
   common-lisp
   (ilisp-load-init 'sbcl ilisp-sbcl-init-file)
 
-  (setq comint-prompt-regexp "^\\([0-9]+\\]+\\|\\*\\) "
-	ilisp-trace-command "(ILISP:sbcl-trace \"%s\" \"%s\" \"%s\")"
+  ;; set the right check-prompt function, according to the right SBCL version:
+  ;; we have to do this after the Lisp has been started, because we have to
+  ;; ask the lisp-process for some info ...
+  ;; ... refactored into its own function.
+  ;; comint-prompt-regexp is now set here, too, in the ILISP-INIT-HOOK-LOCAL,
+  ;; e.g. in VERSION-CUSTOMIZE-SBCL.
+  (add-hook
+   'ilisp-init-hook-local
+   'sbcl-version-hook-fun
+   nil)
+                        
+  (setq	comint-prompt-regexp "^\\([0-9]+\\]+\\|\\*\\) " 
+        ;; we have to set comint-prompt-regexp to something sensible here, before
+        ;; we can set it finally to its right value in our ILISP-INIT-HOOK-LOCAL
+        ;; hook (above).
+        ilisp-trace-command "(ILISP:sbcl-trace \"%s\" \"%s\" \"%s\")"
 	comint-prompt-status 
 	(function (lambda (old line)
 		    (comint-prompt-status old line 'sbcl-check-prompt)))
 	ilisp-reset ":r toplevel"
 	comint-interrupt-regexp "interrupted at"
 
-        ;; hardcoded binary extensions are undesirable, but note that
-        ;; in SBCL 0.7 these will go to "fasl", so there seems little
-        ;; point in getting ilisp{-init-,-}binary-command to work
-        ;; properly if that arrives soon
-
-        ilisp-binary-command nil
-        ilisp-init-binary-command nil
-	ilisp-binary-extension "x86f"
-	ilisp-init-binary-extension "x86f"
-	ilisp-binary-command "\"x86f\""
+        ;; Hardcoded binary extensions are undesirable.
+        ;; Since ilisp-cl.el takes care of ilisp-binary-command and
+        ;; ilisp-init-binary-command we don't need to take care of that here.
+        ;; Even it is was hardcoded, problems would arise, because SBCL-0.7.x
+        ;; uses ".fasl" as an extension, whereas SBCL-0.6.x uses specific
+        ;; extensions (like ".x86f").
+        ;; So go for the general mechanism.
+        ;; instead of the following:
+	;; ilisp-init-binary-command "\"x86f\""
+	;; ilisp-binary-command "\"x86f\""
 	)
 
   ;; ILD Support, largely untested
 
 ;;; end of file -- ilisp-sbcl.el --
 
+
+
+