[slime-cvs] CVS slime

trittweiler trittweiler at common-lisp.net
Fri Aug 24 13:55:25 UTC 2007


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

Modified Files:
	swank.lisp 
Log Message:

	* slime.el (slime-forward-blanks): Wrapped w/ `ignore-errors.'
	(slime-sexp-at-point): Return results as a list of strings, rather
	than just one big string if called with arg > 1.
	(slime-parse-extended-operator-name): Wrapping some movement code
	in `ignore-errors'. Adapted to new return value of
	`slime-enclosing-form-specs'. Minor cosmetic changes.
	(slime-make-extended-operator-parser/look-ahead): Adapted to
	changes of the ``raw form spec'' format; returns a form of
	strings, instead of a string of a form.
	(slime-parse-extended-operator/declare): Simplified. Adapted to
	changes of the ``raw form spec'' format; passes decl-identifiers,
	or typespec-operators respectively, along the decl/type-spec.
	(%slime-in-mid-of-typespec-p): Removed. Replaced by an regexp
	based approach.
	(%slime-nesting-until-point): New helper for
	`slime-parse-extended-operator/declare'.

	* swank.lisp (parse-form-spec): Adapted to new ``raw form spec''
	format. Updated format description in docstring accordingly.


--- /project/slime/cvsroot/slime/swank.lisp	2007/08/23 22:50:40	1.496
+++ /project/slime/cvsroot/slime/swank.lisp	2007/08/24 13:55:25	1.497
@@ -1590,20 +1590,24 @@
 
 A ``raw form spec'' can be either: 
 
-  i)   a string representing a Common Lisp symbol,
+  i)   a list of strings representing a Common Lisp form
 
-  ii)  a string representing a Common Lisp form,
+  ii)  one of:
 
-  iii) a list:
+     a)  (:declaration decl-identifier declspec) 
 
-     a)  (:declaration declspec) 
+           where DECL-IDENTIFIER is the string representation of a /decl identifier/,
+                 DECLSPEC is the string representation of a /declaration specifier/.
 
-           where DECLSPEC is the string representation of a /declaration specifier/,
-
-     b)  (:type-specifier typespec) 
+     b)  (:type-specifier typespec-operator typespec) 
        
-           where TYPESPEC is the string representation of a /type specifier/.
+           where TYPESPEC-OPERATOR is the string representation of the CAR of a /type specifier/,
+                 TYPESPEC is the string representation of a /type specifier/.
 
+     (DECL-IDENTIFIER, and TYPESPEC-OPERATOR are actually redundant (as they're both
+     already provided in DECLSPEC, or TYPESPEC respectively, but this separation
+     allows to check if these raw form specs are valid before the whole spec is READ,
+     and thus all contained symbols interned.)
 
 A ``form spec'' is either
 
@@ -1619,29 +1623,35 @@
 
 Examples:
 
-  \"defmethod\"                       =>  (defmethod)
-  \"cl:defmethod\"                    =>  (cl:defmethod)
-  \"(defmethod print-object)\"        =>  (defmethod print-object)
-  (:declaration \"(optimize)\")       =>  ((:declaration optimize))
-  (:declaration \"(type string)\")    =>  ((:declaration type) string)
-  (:type-specifier \"(float)\")       =>  ((:type-specifier float))
-  (:type-specifier \"(float 0 100)\") =>  ((:type-specifier float) 0 100)
+  (\"defmethod\")                     =>  (defmethod)
+  (\"cl:defmethod\")                  =>  (cl:defmethod)
+  (\"defmethod\" \"print-object\")    =>  (defmethod print-object)
+
+  (:declaration \"optimize\" \"(optimize)\")    =>  ((:declaration optimize))
+  (:declaration \"type\"     \"(type string)\") =>  ((:declaration type) string)
+  (:type-specifier \"float\" \"(float)\")       =>  ((:type-specifier float))
+  (:type-specifier \"float\" \"(float 0 100)\") =>  ((:type-specifier float) 0 100)
 "
-  (typecase raw-spec
-    (string (ensure-list (read-incomplete-form-from-string raw-spec)))
-    (cons                               ; compound form spec
-     (destructure-case raw-spec
-       ((:declaration raw-declspec)
-        (let ((declspec (from-string raw-declspec)))
-          (unless (recursively-empty-p declspec) ; (:DECLARATION "(())") &c.
-            (destructuring-bind (decl-identifier &rest decl-args) declspec
-              `((:declaration ,decl-identifier) , at decl-args)))))
-       ((:type-specifier raw-typespec)
-        (let ((typespec (from-string raw-typespec)))
-          (unless (recursively-empty-p typespec)
-            (destructuring-bind (typespec-op &rest typespec-args) typespec
-              `((:type-specifier ,typespec-op) , at typespec-args)))))))
-    (otherwise nil)))
+  (flet ((parse-extended-spec (raw-extension-op raw-extension extension-flag)
+           (when (nth-value 1 (parse-symbol raw-extension-op))
+             (let ((extension (read-incomplete-form-from-string raw-extension)))
+               (unless (recursively-empty-p extension) ; (:DECLARATION "(())") &c.
+                 (destructuring-bind (identifier &rest args) extension
+                   `((,extension-flag ,identifier) , at args)))))))
+    (when (consp raw-spec)
+      (destructure-case raw-spec
+        ((:declaration raw-decl-identifier raw-declspec)
+         (parse-extended-spec raw-decl-identifier raw-declspec :declaration))
+        ((:type-specifier raw-typespec-op raw-typespec)
+         (parse-extended-spec raw-typespec-op raw-typespec :type-specifier))
+        (t
+         (when (every #'stringp raw-spec)
+           (destructuring-bind (raw-operator &rest raw-args) raw-spec
+             (multiple-value-bind (operator found?) (parse-symbol raw-operator)
+               (when (and found? (valid-operator-symbol-p operator))
+                 `(,operator ,@(read-incomplete-form-from-string
+                                (format nil "(~A)"
+                                        (apply #'concatenate 'string raw-args)))))))))))))
 
 (defun split-form-spec (spec)
   "Returns all three relevant information a ``form spec''
@@ -2432,9 +2442,9 @@
 
   (arglist-from-form-spec '(defun foo)) 
 
-      ~=> (args &body body))
+      ~=> (args &body body)
 
-  (arglist-from-form-spec '(defun foo) :remove-args nil) 
+  (arglist-from-form-spec '(defun foo) :remove-args nil)) 
 
       ~=>  (name args &body body))
 




More information about the slime-cvs mailing list