[slime-cvs] CVS slime

[CVS User trittweiler]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv2544

Modified Files:
	ChangeLog slime.el 
Log Message:
	* slime.el (slime-check-fancy-symbol-name): Use
	`slime-test-expect' instead of `slime-check'.
	([test] fancy-symbol-names): Extend test case; check for
	"Foo" in #<Foo| {...}>.
	(slime-symbol-constituent-at-pos): Check for #<.


--- /project/slime/cvsroot/slime/ChangeLog	2009/03/04 19:43:29	1.1707
+++ /project/slime/cvsroot/slime/ChangeLog	2009/03/04 20:40:01	1.1708
@@ -1,5 +1,13 @@
 2009-03-04  Tobias C. Rittweiler  <tcr at freebits.de>
 
+	* slime.el (slime-check-fancy-symbol-name): Use
+	`slime-test-expect' instead of `slime-check'.
+	([test] fancy-symbol-names): Extend test case; check for
+	"Foo" in #<Foo| {...}>.
+	(slime-symbol-constituent-at-pos): Check for #<.
+
+2009-03-04  Tobias C. Rittweiler  <tcr at freebits.de>
+
 	* slime.el (slime-wait-condition): Remove `save-excursion'; it
 	made the `repl-test' test case fail because this test tries to set
 	point to the new prompt in vain.
--- /project/slime/cvsroot/slime/slime.el	2009/03/04 19:43:29	1.1141
+++ /project/slime/cvsroot/slime/slime.el	2009/03/04 20:40:02	1.1142
@@ -7304,8 +7304,10 @@
   (dotimes (pt (length symbol-name))
     (setq pt (+ buffer-offset pt))
     (goto-char pt)
-    (slime-check ("Checking `%s' (%d)..." (buffer-string) pt)
-      (equal (slime-symbol-at-point) symbol-name))))
+    (slime-test-expect (format "Check `%s' (at %d)..." (buffer-string) pt)
+                       symbol-name 
+                       (slime-symbol-at-point)
+                       #'equal)))
 
 (def-slime-test fancy-symbol-names (symbol-name)
     "Check that we can cope with idiosyncratic symbol names."
@@ -7314,7 +7316,7 @@
       ("|asdf||foo||bar|")
       ("\\|foo|bar|@asdf:foo|\\||")
       ("\\\\\\\\foo|barfo\\\\|asdf")
-      )
+      ("\\#<Foo at Bar>") ("|#<|Foo at Bar|>|") ("|#<Foo at Bar>|"))
   (slime-check-top-level)
   (with-temp-buffer
     (lisp-mode)
@@ -7339,10 +7341,20 @@
     (slime-check-fancy-symbol-name (+ (point-min) 2) symbol-name)
     (erase-buffer)
 
+    (slime-test-message "*** fancy symbol-name with leading `:")
+    (insert "`") (insert symbol-name)
+    (slime-check-fancy-symbol-name (+ (point-min) 1) symbol-name)
+    (erase-buffer)
+
     (slime-test-message "*** fancy symbol-name wrapped in ():")
     (insert "(") (insert symbol-name) (insert ")")
     (slime-check-fancy-symbol-name (+ (point-min) 1) symbol-name)
     (erase-buffer)
+
+    (slime-test-message "*** fancy symbol-name wrapped in #<>:")
+    (insert "#<") (insert symbol-name) (insert " {DEADBEEF}>")
+    (slime-check-fancy-symbol-name (+ (point-min) 2) symbol-name)
+    (erase-buffer)
     ))
 
 (def-slime-test narrowing ()
@@ -8146,17 +8158,20 @@
 
 (defun slime-symbol-constituent-at (pos)
   "Is the character at position POS a valid symbol constituent?"
+  ;; We assume we're not within vertical bars, otherwise boringly
+  ;; everything would be a constituent.
   (when-let (char (char-after pos))                   ; nil when at eob.
     (let* ((char-before   (or (char-before pos) ?\a)) ; nil when at bob.
            (syntax        (char-syntax char))
            (syntax-before (char-syntax char-before)))
-      ;; We assume we're not within vertical bars.
-      (or
-       (memq syntax '(?\w ?\_ ?\\))     ; usual suspects?
-       (eq char ?\|)
-       (eq syntax-before ?\\)           ; escaped?
-       (and (eq char ?\@)               ; ,@@foobar or foo at bar?
-            (not (eq char-before ?\,)))))))
+      (if (and (eq char-before ?\#) (eq char ?\<))    ; #< ?
+          nil
+          (or
+           (memq syntax '(?\w ?\_ ?\\))               ; usual suspects?
+           (eq char ?\|)                              ; |foo|::|bar|?
+           (eq syntax-before ?\\)                     ; escaped?
+           (and (eq char ?\@)                         ; ,@@foobar or foo at bar?
+                (not (eq char-before ?\,))))))))
 
 ;;; `slime-beginning-of-symbol', and `slime-end-of-symbol' are written
 ;;; to get a lot of funky CL-style symbol names right (see