Index: contrib/slime-parse.el
===================================================================
RCS file: /project/slime/cvsroot/slime/contrib/slime-parse.el,v
retrieving revision 1.19
diff -u -r1.19 slime-parse.el
--- contrib/slime-parse.el	27 Feb 2009 21:35:35 -0000	1.19
+++ contrib/slime-parse.el	28 Apr 2009 21:51:50 -0000
@@ -107,7 +107,10 @@
     ("APPLY"          . (slime-make-extended-operator-parser/look-ahead 1))
     ("DECLARE"        . slime-parse-extended-operator/declare)
     ("DECLAIM"        . slime-parse-extended-operator/declare)
-    ("PROCLAIM"       . slime-parse-extended-operator/declare)))
+    ("PROCLAIM"       . slime-parse-extended-operator/declare)
+    ("CHECK-TYPE"     . slime-parse-extended-operator/check-type)
+    ("TYPEP"          . slime-parse-extended-operator/check-type)
+    ("THE"            . slime-parse-extended-operator/the)))
 
 (defun slime-make-extended-operator-parser/look-ahead (steps)
   "Returns a parser that parses the current operator at point
@@ -161,6 +164,29 @@
 					    (first decl-points)))))))))
   (values current-forms current-indices current-points))
 
+(defun slime-parse-extended-operator/check-type
+    (name user-point current-forms current-indices current-points)
+  (if (and (eql 2 (car current-indices))
+           (cadr current-forms)
+           (if (equalp name "typep")
+               (progn (goto-char (- (cadr current-points) 2))
+                      (equal (thing-at-point 'char) "'"))
+               t))
+      (unless (member (caadr current-forms) '("values" "function"))
+        (values `((:type-specifier ,(cadr current-forms)))
+                (cdr current-indices)
+                (cdr current-points)))
+      (values current-forms current-indices current-points)))
+
+(defun slime-parse-extended-operator/the
+    (name user-point current-forms current-indices current-points)
+  (if (and (eql 1 (car current-indices))
+           (cadr current-forms))
+      (values `((:type-specifier ,(cadr current-forms)))
+              (cdr current-indices)
+              (cdr current-points))
+      (values current-forms current-indices current-points)))
+
 (defun slime-nesting-until-point (target-point)
   "Returns the nesting level between current point and TARGET-POINT.
 If TARGET-POINT could not be reached, 0 is returned. (As a result