[slime-cvs] CVS slime
trittweiler
trittweiler at common-lisp.net
Thu Aug 30 23:09:33 UTC 2007
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv5412
Modified Files:
slime.el
Log Message:
* slime.el (slime-sexp-at-point): Explicitely set current syntax
table to operate in `lisp-mode-syntax-table' because
`thing-at-point' is used which depends on the syntax table. (E.h.
keywords like `:foo' aren't recognized as sexp otherwise.)
* slime.el (slime-parse-extended-operator/declare): Wrap regexp
stuff in `save-match-data'
(slime-internal-scratch-buffer): Removed again. (Was only
introduced as a performance hack; but it turned out that the bad
performance was because of unneccessary recursive calls of
`slime-make-form-spec-from-string'. (Which was fixed on 2007-08-27
already.)
(slime-make-form-spec-from-string): Use `with-temp-buffer' instead
of `slime-internal-scratch-buffer'. Removed activation of
`lisp-mode' in the temporary buffer, because this made
`lisp-mode-hooks' run. This activated autodoc in the temp buffer,
although the temp buffer is used to compute an autodoc
itself (which resulted in some very mutual recursion which caused
the current arglist to be displayed again and again---as could
have been witnessed in `*Messages*'.) `Lisp-mode' was activated to
get the right syntax-table for `slime-sexp-at-point', but this one
sets the correct syntax-table itself now.
--- /project/slime/cvsroot/slime/slime.el 2007/08/29 01:08:25 1.837
+++ /project/slime/cvsroot/slime/slime.el 2007/08/30 23:09:33 1.838
@@ -9915,23 +9915,26 @@
(or (thing-at-point 'sexp)
(slime-symbol-name-at-point)))))
(if string (substring-no-properties string) nil))))
- (save-excursion
- (when skip-blanks-p ; e.g. `( foo bat)' where point is after ?\(.
- (slime-forward-blanks))
- (let ((result nil))
- (dotimes (i n)
- ;; `foo(bar baz)' where point is at ?\(.
- (let ((sexp (sexp-at-point :symbol-first)))
- (if (equal sexp (first result))
+ ;; `thing-at-point' depends upon the current syntax table; otherwise
+ ;; keywords like `:foo' are not recognized as sexps. (This function
+ ;; may be called from temporary buffers etc.)
+ (with-syntax-table lisp-mode-syntax-table
+ (save-excursion
+ (when skip-blanks-p ; e.g. `( foo bat)' where point is after ?\(.
+ (slime-forward-blanks))
+ (let ((result nil))
+ (dotimes (i n)
+ ;; `foo(bar baz)' where point is at ?\( or ?\).
+ (if (member (char-syntax (char-after)) '(?\( ?\) ?\'))
(push (sexp-at-point :sexp-first) result)
- (push sexp result)))
- (ignore-errors (forward-sexp) (slime-forward-blanks))
- (save-excursion
- (unless (slime-point-moves-p (ignore-errors (forward-sexp)))
- (return))))
- (if (slime-length= result 1)
- (first result)
- (nreverse result))))))
+ (push (sexp-at-point :symbol-first) result))
+ (ignore-errors (forward-sexp) (slime-forward-blanks))
+ (save-excursion
+ (unless (slime-point-moves-p (ignore-errors (forward-sexp)))
+ (return))))
+ (if (slime-length= result 1)
+ (first result)
+ (nreverse result)))))))
(defun slime-sexp-at-point-or-error ()
"Return the sexp at point as a string, othwise signal an error."
@@ -9970,7 +9973,6 @@
(funcall parser op-name user-point forms indices points))))))
(values forms indices points))
-
(defvar slime-extended-operator-name-parser-alist
'(("MAKE-INSTANCE" . (slime-make-extended-operator-parser/look-ahead 1))
("MAKE-CONDITION" . (slime-make-extended-operator-parser/look-ahead 1))
@@ -9983,25 +9985,19 @@
("APPLY" . (slime-make-extended-operator-parser/look-ahead 1))
("DECLARE" . slime-parse-extended-operator/declare)))
-;; FIXME: How can this buffer best be hidden from the user? I think there
-;; are some ignoration variables; gotta check that.
-(defvar slime-internal-scratch-buffer (generate-new-buffer "SLIME-INTERNAL")
- "")
(defun slime-make-extended-operator-parser/look-ahead (steps)
"Returns a parser that parses the current operator at point
plus STEPS-many additional sexps on the right side of the
operator."
(lexical-let ((n steps))
- (byte-compile
- #'(lambda (name user-point current-forms current-indices current-points)
- (let ((old-forms (rest current-forms)))
- (let* ((args (slime-ensure-list (slime-sexp-at-point n)))
- (arg-specs (mapcar #'slime-make-form-spec-from-string args)))
- (setq current-forms (cons `(,name , at arg-specs) old-forms))))
- (values current-forms current-indices current-points)
- ))))
-
+ #'(lambda (name user-point current-forms current-indices current-points)
+ (let ((old-forms (rest current-forms)))
+ (let* ((args (slime-ensure-list (slime-sexp-at-point n)))
+ (arg-specs (mapcar #'slime-make-form-spec-from-string args)))
+ (setq current-forms (cons `(,name , at arg-specs) old-forms))))
+ (values current-forms current-indices current-points)
+ )))
(defun slime-parse-extended-operator/declare
(name user-point current-forms current-indices current-points)
@@ -10018,20 +10014,20 @@
(nesting (slime-nesting-until-point decl-pos))
(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-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 ((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))))))))
+ (save-match-data ; `(declare ((foo ...))' or `(declare (type (foo ...)))' ?
+ (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 ((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))
(defun slime-nesting-until-point (target-point)
@@ -10047,7 +10043,8 @@
nesting
0))))
-(defun slime-make-form-spec-from-string (string &optional strip-operator-p temp-buffer)
+
+(defun slime-make-form-spec-from-string (string &optional strip-operator-p)
"If STRIP-OPERATOR-P is T and STRING is the string
representation of a form, the string representation of this form
is stripped from the form. This can be important to avoid mutual
@@ -10055,11 +10052,13 @@
`slime-parse-extended-operator-name'."
(if (slime-length= string 0)
""
- (with-current-buffer (or temp-buffer slime-internal-scratch-buffer)
- (common-lisp-mode) ; important for `slime-sexp-at-point'.
+ (with-temp-buffer
+ ;; Do NEVER ever try to activate `lisp-mode' here with
+ ;; `slime-use-autodoc-mode' enabled, as this function is used
+ ;; to compute the current autodoc itself.
(erase-buffer)
(insert string)
- (when strip-operator-p
+ (when strip-operator-p ; `(OP arg1 arg2 ...)' ==> `(arg1 arg2 ...)'
(goto-char (point-min))
(when (string= (thing-at-point 'char) "(")
(ignore-errors (forward-char 1)
@@ -10067,18 +10066,18 @@
(slime-forward-blanks))
(delete-region (point-min) (point))
(insert "(")))
- (goto-char (1- (point-max))) ; for `slime-enclosing-form-specs'
+ (goto-char (1- (point-max))) ; `(OP arg1 ... argN|)'
(multiple-value-bind (forms indices points)
(slime-enclosing-form-specs 1)
(if (null forms)
string
- (progn
- (goto-char (1+ (point-min)))
+ (let ((n (first (last indices))))
+ (goto-char (1+ (point-min))) ; `(|OP arg1 ... argN)'
(mapcar #'(lambda (s)
- (assert (not (equal s string)))
- (slime-make-form-spec-from-string s temp-buffer))
+ (assert (not (equal s string))) ; trap against
+ (slime-make-form-spec-from-string s)) ; endless recursion.
(slime-ensure-list
- (slime-sexp-at-point (1+ (first (last indices))) t)))))))))
+ (slime-sexp-at-point (1+ n) t)))))))))
(defun slime-enclosing-form-specs (&optional max-levels)
More information about the slime-cvs
mailing list