[climacs-cvs] CVS climacs

[thenriksen]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv28737

Modified Files:
	lisp-syntax.lisp lisp-syntax-commands.lisp 
Log Message:
Non-10 bases should work properly now.


--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp	2006/07/23 20:31:56	1.97
+++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp	2006/07/24 08:20:27	1.98
@@ -72,8 +72,7 @@
                  designator in the form. The list is sorted with
                  the earliest (in-package) forms last (descending
                  offset).")
-   (base :accessor base
-         :initform 10
+   (base :initform nil
          :documentation "The base which numbers in the buffer are
          expected to be in.")
    (option-specified-package :accessor option-specified-package
@@ -91,6 +90,13 @@
   (:pathname-types "lisp" "lsp" "cl")
   (:command-table lisp-table))
 
+(defgeneric base (syntax)
+  (:documentation "Get the base `syntax' should interpret numbers
+  in.")
+  (:method ((syntax lisp-syntax))
+    (or (slot-value syntax 'base)
+        *read-base*)))
+
 (define-option-for-syntax lisp-syntax "Package" (syntax package-name)
   (let ((specified-package (find-package package-name)))
     (setf (option-specified-package syntax) (or specified-package package-name))))
@@ -160,7 +166,8 @@
 the source code.")
   (:method (image form buffer buffer-mark)
     (compile-string-for-climacs image
-                                (write-to-string form)
+                                (let ((*print-base* (base (syntax buffer))))
+                                  (write-to-string form))
                                 *package* buffer buffer-mark)))
 
 (defgeneric compile-file-for-climacs (image filepath package &optional load-p)
@@ -3086,23 +3093,26 @@
 
 (defun eval-region (start end syntax)
   ;; Must be (mark>= end start).
-  (with-slots (package) syntax
-    (let* ((string (buffer-substring (buffer start)
-                                     (offset start)
-                                     (offset end)))
-           (values (multiple-value-list
-                    (eval-string syntax string)))
-           ;; Enclose each set of values in {}.
-           (result (apply #'format nil "~{{~:[No values~;~:*~{~S~^,~}~]}~}"
-                          values)))
-      (esa:display-message result))))
+  (with-syntax-package syntax start (package)
+    (let ((*package* package)
+          (*read-base* (base syntax)))
+      (let* ((string (buffer-substring (buffer start)
+                                       (offset start)
+                                       (offset end)))
+             (values (multiple-value-list
+                      (eval-string syntax string)))
+             ;; Enclose each set of values in {}.
+             (result (apply #'format nil "~{{~:[No values~;~:*~{~S~^,~}~]}~}"
+                            values)))
+        (esa:display-message result)))))
 
 (defun compile-definition-interactively (mark syntax)
   (with-syntax-package syntax mark (package)
     (let* ((token (definition-at-mark mark syntax))
            (string (token-string syntax token))
            (m (clone-mark mark))
-           (buffer-name (name (buffer syntax))))
+           (buffer-name (name (buffer syntax)))
+           (*read-base* (base syntax)))
       (forward-definition m syntax)
       (backward-definition m syntax)
       (multiple-value-bind (result notes)
@@ -3122,12 +3132,13 @@
              (accept 'boolean :prompt (format nil "Save buffer ~A ?" (name buffer))))
     (climacs-gui::save-buffer buffer))
   (with-syntax-package (syntax buffer) 0 (package)
-    (multiple-value-bind (result notes)
-        (compile-file-for-climacs (get-usable-image (syntax buffer))
-                                  (filepath buffer)
-                                  package load-p)
-      (show-note-counts notes (second result))
-      (when notes (show-notes notes (name buffer) "")))))
+    (let ((*read-base* (base (syntax buffer))))
+      (multiple-value-bind (result notes)
+          (compile-file-for-climacs (get-usable-image (syntax buffer))
+                                    (filepath buffer)
+                                    package load-p)
+        (show-note-counts notes (second result))
+        (when notes (show-notes notes (name buffer) ""))))))
 
 ;;; Parameter hinting
 
--- /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp	2006/07/23 20:31:56	1.10
+++ /project/climacs/cvsroot/climacs/lisp-syntax-commands.lisp	2006/07/24 08:20:28	1.11
@@ -104,7 +104,8 @@
          (token (form-before syntax (offset mark))))
     (if token
         (with-syntax-package syntax mark (package)
-          (let ((*package* package))
+          (let ((*package* package)
+                (*read-base* (base syntax)))
             (climacs-gui::com-eval-expression
              (token-to-object syntax token :read t)
              insertp)))
@@ -141,9 +142,8 @@
         (point (point (current-window))))
     (when (mark> mark point)
       (rotatef mark point))
-    (evaluating-interactively
-     (eval-region mark point
-                  (syntax (buffer (current-window)))))))
+    (eval-region mark point
+                 (syntax (buffer (current-window))))))
 
 (define-command (com-compile-definition :name t :command-table lisp-table)
     ()