[slime-cvs] CVS slime

[alendvai]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv1526

Modified Files:
	slime.el swank.lisp 
Log Message:
FIX: slime-insert-possibly-as-rectange and sldb stuff on newer emacsen


--- /project/slime/cvsroot/slime/slime.el	2007/01/04 16:30:09	1.733
+++ /project/slime/cvsroot/slime/slime.el	2007/01/05 16:27:35	1.734
@@ -3030,9 +3030,12 @@
             (let ((lines (split-string string "\n")))
               (when (rest lines)
                 (save-excursion
-                  (dotimes (i (1- (length lines)))
+                  (dotimes (i (length lines))
                     (newline))))
-              (insert-rectangle lines))))))
+              (insert-rectangle lines)
+              (when (rest lines)
+                (forward-char 1)
+                (delete-backward-char 1)))))))
 
 (defun slime-insert-presentation (string output-id)
   (cond ((not slime-repl-enable-presentations)
@@ -8428,15 +8431,19 @@
 
 (defun sldb-insert-frame (frame &optional detailedp)
   (destructuring-bind (number string) frame
-    (let ((props `(frame ,frame sldb-default-action sldb-toggle-details)))
-      (save-excursion
-        (slime-insert-propertized props "\n"))
+    (let ((props `(frame ,frame sldb-default-action sldb-toggle-details))
+          (frame-end-marker (point-marker)))
+      (set-marker-insertion-type frame-end-marker t)
       (slime-propertize-region props
+        (save-excursion
+          (newline))
         (insert " " (in-sldb-face frame-label (format "%2d:" number)) " ")
         (slime-insert-possibly-as-rectangle
          (if detailedp
              (in-sldb-face detailed-frame-line string)
-             (in-sldb-face frame-line string)))))))
+             (in-sldb-face frame-line string)))
+        (goto-char frame-end-marker))
+      (set-marker frame-end-marker nil))))
 
 (defun sldb-insert-frames (frames maximum-length)
   "Insert FRAMES into buffer.
@@ -8445,10 +8452,7 @@
     (when maximum-length
       (assert (<= (length frames) maximum-length)))
     (save-excursion
-      (mapc (lambda (frame)
-              (sldb-insert-frame frame)
-              (newline))
-            frames)
+      (mapc #'sldb-insert-frame frames)
       (let ((number (sldb-previous-frame-number)))
         (cond ((and maximum-length (< (length frames) maximum-length)))
               (t
@@ -8596,28 +8600,41 @@
                        (sldb-catch-tags frame-number)))
          (local-vars (sldb-frame-locals frame-number)))
     (if (or catch-tags local-vars)
-        (multiple-value-bind (start end) (sldb-frame-region)
-          (save-excursion
-            (goto-char start)
+        (save-excursion
+          (multiple-value-bind (start end) (sldb-frame-region)
             (let* ((standard-output (current-buffer))
                    (indent1 "      ")
                    (indent2 "        "))
               (delete-region start end)
+              (goto-char start)
               (slime-propertize-region `(frame ,frame details-visible-p t)
                 (sldb-insert-frame frame t)
                 (when local-vars
-                  (insert "\n" indent1 (in-sldb-face section "Locals:"))
+                  (insert indent1 (in-sldb-face section "Locals:"))
                   (sldb-insert-locals frame-number indent2 local-vars))
                 (when catch-tags
-                  (insert "\n" indent1 (in-sldb-face section "Catch-tags:"))
+                  (when local-vars
+                    (insert "\n"))
+                  (insert indent1 (in-sldb-face section "Catch-tags:"))
                   (dolist (tag catch-tags)
                     (slime-insert-propertized '(catch-tag ,tag)
                       "\n"
                       indent2
-                      (in-sldb-face catch-tag (format "%s" tag)))))))))
+                      (in-sldb-face catch-tag (format "%s" tag)))))
+                (newline)))))
         (message "Nothing to display")
         (apply #'sldb-maybe-recenter-region (sldb-frame-region)))))
 
+(defun sldb-hide-frame-details ()
+  (save-excursion
+    (multiple-value-bind (start end) (sldb-frame-region)
+      (goto-char start)
+      (let* ((props (text-properties-at (point)))
+	     (frame (plist-get props 'frame)))
+	(delete-region start end)
+	(slime-propertize-region (plist-put props 'details-visible-p nil)
+          (sldb-insert-frame frame))))))
+
 (defun sldb-frame-region ()
   (save-excursion
     (goto-char (next-single-property-change (point) 'frame nil (point-max)))
@@ -8635,16 +8652,6 @@
 		  (recenter (max (- (window-height) lines 4) 0)))
 		 (t (recenter 1)))))))
 
-(defun sldb-hide-frame-details ()
-  (save-excursion
-    (multiple-value-bind (start end) (sldb-frame-region)
-      (goto-char start)
-      (let* ((props (text-properties-at (point)))
-	     (frame (plist-get props 'frame)))
-	(delete-region start end)
-	(slime-propertize-region (plist-put props 'details-visible-p nil)
-          (sldb-insert-frame frame))))))
-
 
 (defun sldb-eval-in-frame (string)
   "Prompt for an expression and evaluate it in the selected frame."
--- /project/slime/cvsroot/slime/swank.lisp	2007/01/04 16:27:05	1.450
+++ /project/slime/cvsroot/slime/swank.lisp	2007/01/05 16:27:35	1.451
@@ -4487,7 +4487,6 @@
                                            (not (string= value-string "")))
                                   (setf (swank-mop:slot-value-using-class class object slot)
                                         (eval (read-from-string value-string))))))))
-               " "
                ,@(when boundp
                    `(" " (:action "[make unbound]"
                           ,(lambda () (swank-mop:slot-makunbound-using-class class object slot)))))))))
@@ -4667,7 +4666,8 @@
     (values "A package."
             `("Name: " (:value ,(package-name package))
               (:newline)
-              "Nick names: " ,@(common-seperated-spec (sort (package-nicknames package) #'string-lessp))
+              "Nick names: " ,@(common-seperated-spec (sort (copy-seq (package-nicknames package))
+                                                            #'string-lessp))
               (:newline)
               ,@(when (documentation package t)
                   `("Documentation:" (:newline)