[slime-cvs] CVS slime
trittweiler
trittweiler at common-lisp.net
Sun Aug 26 23:35:25 UTC 2007
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv22769
Modified Files:
slime.el
Log Message:
Reduces needless interning of symbols that was introduced by my
recent work on autodoc to a minimum. Also fixes this issue for
`slime-complete-form' which always interned symbols even before my
changes.
* slime.el (slime-sexp-at-point): If N is given, but there aren't
N sexps available at point, make it return a list of just as many
as there are.
(slime-make-form-spec-from-string): New. Creates a ``raw form
spec'' from a string that's suited for determining newly interned
symbols later in Swank.
(slime-parse-extended-operator/declare): Uses it.
* swank.lisp (parse-symbol): Returns internal knowledge, to
provide a means for callers to perform a sanity check.
(call-with-ignored-reader-errors): New. Abstracted out from
`read-incomplete-form-from-string.'
* swank.lisp (read-form-spec): New. Only READs elements of a form
spec if necessary. And if it does have to READ, it keeps track
of newly interned symbols which are returned as secondary
return value.
(parse-form-spec): Use it. Propagate newly interned symbols.
(parse-first-valid-form-spec): Likewise.
(arglist-for-echo-area, complete-form, completions-for-keyword):
Adapted to unintern the newly interned symbols.
--- /project/slime/cvsroot/slime/slime.el 2007/08/26 10:38:59 1.821
+++ /project/slime/cvsroot/slime/slime.el 2007/08/26 23:35:25 1.822
@@ -1,3 +1,4 @@
+
;;; slime.el -- Superior Lisp Interaction Mode for Emacs
;;
;;;; License
@@ -5743,11 +5744,11 @@
""
(let ((op (first operators)))
(destructure-case (slime-ensure-list op)
- ((:declaration decl-identifier declspec) op)
- ((:type-specifier typespec-op typespec) op)
+ ((:declaration declspec) op)
+ ((:type-specifier typespec) op)
(t (slime-ensure-list
(save-excursion (goto-char (first points))
- (slime-sexp-at-point (first arg-indices))))))))))
+ (slime-sexp-at-point (1+ (first arg-indices)))))))))))
(defun slime-complete-form ()
"Complete the form at point.
@@ -10464,7 +10465,10 @@
(and name (intern name))))
(defun slime-sexp-at-point (&optional n)
- "Return the sexp at point as a string, otherwise nil."
+ "Return the sexp at point as a string, otherwise nil.
+If N is given and greater than 1, a list of all such sexps
+following the sexp at point is returned. (If there are not
+as many sexps as N, a list with < N sexps is returned.)"
(interactive "p") (or n (setq n 1))
(flet ((sexp-at-point ()
(let ((string (or (slime-symbol-name-at-point)
@@ -10472,10 +10476,12 @@
(if string (substring-no-properties string) nil))))
(save-excursion
(let ((result nil))
- (push (format "%s" (sexp-at-point)) result)
- (dotimes (i (1- n))
- (forward-sexp) (forward-char 1)
- (push (format " %s" (sexp-at-point)) result))
+ (dotimes (i n)
+ (push (sexp-at-point) result)
+ (ignore-errors (forward-sexp) (forward-char 1))
+ (save-excursion
+ (unless (slime-point-moves-p (ignore-errors (forward-sexp)))
+ (return))))
(if (slime-length= result 1)
(first result)
(nreverse result))))))
@@ -10558,18 +10564,18 @@
(decl-points (rest current-points))
(decl-pos (1- (first decl-points)))
(nesting (slime-nesting-until-point decl-pos))
- (declspec (concat (slime-incomplete-sexp-at-point nesting)
+ (declspec-str (concat (slime-incomplete-sexp-at-point nesting)
(make-string nesting ?\)))))
;; `(declare ((foo ...))' or `(declare (type (foo ...)))' ?
- (if (or (eql 0 (string-match "\\s-*(\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$" declspec))
- (eql 0 (string-match "\\s-*(type\\s-*\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$" declspec)))
- (let ((typespec-op (first (second decl-ops)))
- (typespec (match-string 1 declspec)))
- (setq current-forms (list `(:type-specifier ,typespec-op ,typespec)))
+ (if (or (eql 0 (string-match "\\s-*(\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$" declspec-str))
+ (eql 0 (string-match "\\s-*(type\\s-*\\((\\(\\sw\\|\\s_\\|\\s-\\)*)\\))$" declspec-str)))
+ (let* ((typespec-str (match-string 1 declspec-str))
+ (typespec (slime-make-form-spec-from-string typespec-str)))
+ (setq current-forms (list `(:type-specifier ,typespec)))
(setq current-indices (list (second decl-indices)))
(setq current-points (list (second decl-points))))
- (let ((decl-identifier (first (first decl-ops))))
- (setq current-forms (list `(:declaration ,decl-identifier ,declspec)))
+ (let ((declspec (slime-make-form-spec-from-string declspec-str)))
+ (setq current-forms (list `(:declaration ,declspec)))
(setq current-indices (list (first decl-indices)))
(setq current-points (list (first decl-points)))))))))
(values current-forms current-indices current-points))
@@ -10584,7 +10590,26 @@
nesting
0))))
-
+(defun slime-make-form-spec-from-string (string &optional temp-buffer)
+ (let ((tmpbuf (or temp-buffer (generate-new-buffer "TMP"))))
+ (if (slime-length= string 0)
+ ""
+ (unwind-protect
+ (with-current-buffer tmpbuf
+ (erase-buffer)
+ (insert string) (backward-char 1)
+ (multiple-value-bind (forms indices points)
+ (slime-enclosing-form-specs 1)
+ (if (null forms)
+ string
+ (progn
+ (beginning-of-line) (forward-char 1)
+ (mapcar #'(lambda (string)
+ (slime-make-form-spec-from-string string tmpbuf))
+ (slime-ensure-list
+ (slime-sexp-at-point (1+ (first (last indices))))))))))
+ (when (not temp-buffer)
+ (kill-buffer tmpbuf))))))
(defun slime-enclosing-form-specs (&optional max-levels)
@@ -10602,13 +10627,13 @@
parens.
\(See SWANK::PARSE-FORM-SPEC for more information about what
-exactly constitutes a ``raw form specs'')
+exactly constitutes a ``raw form specs''
-Example:
+Example:)
A return value like the following
- (values (\"quux\" \"bar\" \"foo\") (3 2 1) (p1 p2 p3))
+ (values ((\"quux\") (\"bar\") (\"foo\")) (3 2 1) (p1 p2 p3))
can be interpreted as follows:
@@ -11055,7 +11080,10 @@
slime-insert-propertized
slime-insert-possibly-as-rectangle
slime-tree-insert
- slime-enclosing-form-specs)))
+ slime-enclosing-form-specs
+ slime-make-form-spec-from-string
+ slime-parse-extended-operator/declare
+)))
(run-hooks 'slime-load-hook)
More information about the slime-cvs
mailing list