[slime-cvs] CVS update: slime/slime.el
Helmut Eller
heller at common-lisp.net
Mon Jun 28 16:02:54 UTC 2004
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv11732
Modified Files:
slime.el
Log Message:
(slime-buffer-package): Return the cached package if find anything
sensible as we did earlier versions. The Lisp side will now fall back
to an existing package if the one supplied by Emacs doesn't exist.
Using the cached version is also necessary for some commands in the
apropos buffer.
(sldb-insert-frame): Set the default-action property; now RET toggles
the details on frame lines.
(sldb-toggle-details): Preserve the current column.
(slime-inspector-buffer, slime-saved-window-config)
(slime-inspector-quit): Save and the window configuration.
(slime-highlight-suppressed-forms, slime-search-suppressed-forms):
Display expressions with reader conditionals (#+/#-) where the test is
false in font-lock-comment-face. No implemented for XEmacs.
(repl-return): New test.
Date: Mon Jun 28 09:02:54 2004
Author: heller
Index: slime/slime.el
diff -u slime/slime.el:1.341 slime/slime.el:1.342
--- slime/slime.el:1.341 Mon Jun 28 05:40:49 2004
+++ slime/slime.el Mon Jun 28 09:02:54 2004
@@ -728,9 +728,7 @@
(force-mode-line-update)))
string)
(t
- (if dont-cache
- "COMMON-LISP-USER"
- slime-buffer-package))))))
+ slime-buffer-package)))))
(defun slime-find-buffer-package ()
"Figure out which Lisp package the current buffer is associated with."
@@ -5526,12 +5524,14 @@
collect frame)
frames))
-(defun sldb-insert-frame (frame)
+(defun sldb-insert-frame (frame &optional detailedp)
(destructuring-bind (number string) frame
(slime-insert-propertized
- `(frame ,frame)
+ `(frame ,frame sldb-default-action sldb-toggle-details)
" " (in-sldb-face frame-label (format "%d" number)) ": "
- (in-sldb-face frame-line string)
+ (if detailedp
+ (in-sldb-face detailed-frame-line string)
+ (in-sldb-face frame-line string))
"\n")))
(defun sldb-insert-frames (frames maximum-length)
@@ -5664,10 +5664,12 @@
The details include local variable bindings and CATCH-tags."
(interactive)
(sldb-frame-number-at-point)
- (let ((inhibit-read-only t))
+ (let ((inhibit-read-only t)
+ (column (current-column)))
(if (or on (not (sldb-frame-details-visible-p)))
(sldb-show-frame-details)
- (sldb-hide-frame-details))))
+ (sldb-hide-frame-details))
+ (move-to-column column)))
(defun sldb-frame-details-visible-p ()
(and (get-text-property (point) 'frame)
@@ -5684,11 +5686,9 @@
(indent1 " ")
(indent2 " "))
(delete-region start end)
- (slime-propertize-region (plist-put props 'details-visible-p t)
- (insert " "
- (in-sldb-face frame-label (format "%d" frame-number)) ": "
- (in-sldb-face detailed-frame-line (second frame)) "\n"
- indent1 (in-sldb-face section "Locals:") "\n")
+ (slime-propertize-region `(frame ,frame details-visible-p t)
+ (sldb-insert-frame frame t)
+ (insert indent1 (in-sldb-face section "Locals:") "\n")
(sldb-insert-locals frame-number indent2)
(when sldb-show-catch-tags
(let ((catchers (sldb-catch-tags frame-number)))
@@ -6109,6 +6109,7 @@
:group 'slime-inspector)
(defvar slime-inspector-mark-stack '())
+(defvar slime-saved-window-config)
(defun slime-inspect (string)
"Eval an expression and inspect the result."
@@ -6129,10 +6130,12 @@
(setq slime-inspector-mark-stack '())
(slime-mode t)
(slime-inspector-mode)
+ (make-local-variable 'slime-saved-window-config)
+ (setq slime-saved-window-config (current-window-configuration))
(current-buffer))))
-(defun slime-inspector-fontify (face string)
- (slime-add-face (intern (format "slime-inspector-%s-face" face)) string))
+(defmacro slime-inspector-fontify (face string)
+ `(slime-add-face ',(intern (format "slime-inspector-%s-face" face)) ,string))
(defun slime-open-inspector (inspected-parts &optional point)
"Display INSPECTED-PARTS in a new inspector window.
@@ -6142,7 +6145,7 @@
(erase-buffer)
(destructuring-bind (&key text type primitive-type parts) inspected-parts
(macrolet ((fontify (face string)
- `(slime-inspector-fontify ',face ,string)))
+ `(slime-inspector-fontify ,face ,string)))
(insert (fontify topline text))
(while (eq (char-before) ?\n) (backward-delete-char 1))
(insert "\n"
@@ -6193,6 +6196,7 @@
(defun slime-inspector-quit ()
(interactive)
(slime-eval-async `(swank:quit-inspector) nil (lambda (_)))
+ (set-window-configuration slime-saved-window-config)
(kill-buffer (current-buffer)))
(defun slime-inspector-describe ()
@@ -6424,6 +6428,48 @@
(ignore-errors (end-of-defun) t))
do (insert ")")))
+
+
+;;; Font Lock
+
+(defcustom slime-highlight-suppressed-forms t
+ "If enabled highlight reader conditionalized forms if the test is false."
+ :type '(choice (const :tag "Enable" t) (const :tag "Disable" nil))
+ :group 'slime)
+
+(defun slime-search-suppressed-forms (limit)
+ "Find reader conditionalized forms where the test is false."
+ (when (and slime-highlight-suppressed-forms
+ (slime-connected-p)
+ (re-search-forward "[ \n\t\r]#[-+]" limit t))
+ (ignore-errors
+ (let* ((char (char-before))
+ (e (read (current-buffer)))
+ (val (slime-eval-feature-conditional e)))
+ (when (<= (point) limit)
+ (if (or (and (eq char ?+) (not val))
+ (and (eq char ?-) val))
+ (let ((start (point)))
+ (forward-sexp)
+ (assert (<= (point) limit))
+ (let ((md (match-data)))
+ (fill md nil)
+ (setf (first md) start)
+ (setf (second md) (point))
+ (set-match-data md)
+ t))
+ (slime-search-suppressed-forms limit)))))))
+
+;; XXX add XEmacs compatibility
+(defun slime-activate-font-lock-magic ()
+ (font-lock-add-keywords
+ 'lisp-mode
+ '((slime-search-suppressed-forms 0 font-lock-comment-face t))))
+
+(when (and (fboundp 'font-lock-add-keywords)
+ slime-highlight-suppressed-forms)
+ (slime-activate-font-lock-magic))
+
;;; Indentation
@@ -7024,6 +7070,37 @@
(slime-test-expect "Buffer contains result"
result-contents (buffer-string))))
+(def-slime-test repl-return
+ (before after result-contents)
+ "Test if slime-repl-return sends the correct protion to Lisp even
+if point is not at the end of the line."
+ '(("(+ 1 2)" "" "SWANK> (+ 1 2)
+3
+SWANK> ")
+("(+ 1 " "2)" "SWANK> (+ 1 2)
+3
+SWANK> ")
+
+("(+ 1\n" "2)" "SWANK> (+ 1
+2)
+3
+SWANK> ")
+
+)
+ (with-current-buffer (slime-output-buffer)
+ (setf (slime-lisp-package) "SWANK"))
+ (kill-buffer (slime-output-buffer))
+ (with-current-buffer (slime-output-buffer)
+ (insert before)
+ (save-excursion (insert after))
+ (slime-test-expect "Buffer contains input"
+ (concat "SWANK> " before after)
+ (buffer-string))
+ (call-interactively 'slime-repl-return)
+ (slime-sync-to-top-level 5)
+ (slime-test-expect "Buffer contains result"
+ result-contents (buffer-string))))
+
(def-slime-test repl-read
(prompt input result-contents)
"Test simple commands in the minibuffer."
@@ -7116,7 +7193,7 @@
(with-current-buffer (sldb-get-default-buffer)
(sldb-quit))
(slime-sync-to-top-level 5))
-
+
;;; Portability library
More information about the slime-cvs
mailing list