26
26
(slime-make-form-spec-from-string
27
27
(concat (slime-incomplete-sexp-at-point) ")"))))))))
29
;; XXX: unused function
30
(defun slime-cl-symbol-external-ref-p (symbol)
31
"Does SYMBOL refer to an external symbol?
32
FOO:BAR is an external reference.
33
FOO::BAR is not, and nor is BAR."
34
(let ((name (if (stringp symbol) symbol (symbol-name symbol))))
35
(and (string-match ":" name)
36
(not (string-match "::" name)))))
38
(defun slime-cl-symbol-name (symbol)
39
(let ((n (if (stringp symbol) symbol (symbol-name symbol))))
40
(if (string-match ":\\([^:]*\\)$" n)
41
(let ((symbol-part (match-string 1 n)))
42
(if (string-match "^|\\(.*\\)|$" symbol-part)
43
(match-string 1 symbol-part)
47
(defun slime-cl-symbol-package (symbol &optional default)
48
(let ((n (if (stringp symbol) symbol (symbol-name symbol))))
49
(if (string-match "^\\([^:]*\\):" n)
53
;; XXX: unused function
54
(defun slime-qualify-cl-symbol (symbol-or-name)
55
"Like `slime-qualify-cl-symbol-name', but interns the result."
56
(intern (slime-qualify-cl-symbol-name symbol-or-name)))
58
(defun slime-qualify-cl-symbol-name (symbol-or-name)
59
"Return a package-qualified symbol-name that indicates the CL symbol
60
SYMBOL. If SYMBOL doesn't already have a package prefix the current
62
(let ((s (if (stringp symbol-or-name)
64
(symbol-name symbol-or-name))))
65
(if (slime-cl-symbol-package s)
68
(let* ((package (slime-current-package)))
69
;; package is a string like ":cl-user" or "CL-USER".
70
(if (and package (string-match "^:" package))
73
(slime-cl-symbol-name s)))))
76
29
(defun slime-parse-sexp-at-point (&optional n skip-blanks-p)
77
"Return the sexp at point as a string, otherwise nil.
78
If N is given and greater than 1, a list of all such sexps
79
following the sexp at point is returned. (If there are not
80
as many sexps as N, a list with < N sexps is returned.)
30
"Returns the sexps at point as a list of strings, otherwise nil.
31
\(If there are not as many sexps as N, a list with < N sexps is
82
33
If SKIP-BLANKS-P is true, leading whitespaces &c are skipped.
84
35
(interactive "p") (or n (setq n 1))
85
36
(flet ((sexp-at-point (first-choice)
86
37
(let ((string (if (eq first-choice :symbol-first)
87
(or (slime-symbol-name-at-point)
38
(or (slime-symbol-at-point)
88
39
(thing-at-point 'sexp))
89
40
(or (thing-at-point 'sexp)
90
(slime-symbol-name-at-point)))))
41
(slime-symbol-at-point)))))
91
42
(if string (substring-no-properties string) nil))))
92
;; `thing-at-point' depends upon the current syntax table; otherwise
93
;; keywords like `:foo' are not recognized as sexps. (This function
94
;; may be called from temporary buffers etc.)
95
(with-syntax-table lisp-mode-syntax-table
97
(when skip-blanks-p ; e.g. `( foo bat)' where point is after ?\(.
98
(slime-forward-blanks))
101
;; `foo(bar baz)' where point is at ?\( or ?\).
102
(if (and (char-after) (member (char-syntax (char-after)) '(?\( ?\) ?\')))
103
(push (sexp-at-point :sexp-first) result)
104
(push (sexp-at-point :symbol-first) result))
105
(ignore-errors (forward-sexp) (slime-forward-blanks))
107
(unless (slime-point-moves-p (ignore-errors (forward-sexp)))
109
(if (slime-length= result 1)
111
(nreverse result)))))))
44
(when skip-blanks-p ; e.g. `( foo bat)' where point is after ?\(.
45
(slime-forward-blanks))
48
(push (slime-sexp-at-point) result)
50
(ignore-errors (forward-sexp) (slime-forward-blanks))
51
;; Is there an additional sexp in front of us?
53
(unless (slime-point-moves-p (ignore-errors (forward-sexp)))
57
(defun slime-has-symbol-syntax-p (string)
58
(if (and string (not (zerop (length string))))
59
(member (char-syntax (aref string 0))
113
62
(defun slime-incomplete-sexp-at-point (&optional n)
114
63
(interactive "p") (or n (setq n 1))
160
112
(defun slime-make-extended-operator-parser/look-ahead (steps)
161
113
"Returns a parser that parses the current operator at point
162
plus STEPS-many additional sexps on the right side of the
114
plus (at most) STEPS-many additional sexps on the right side of
164
116
(lexical-let ((n steps))
165
117
#'(lambda (name user-point current-forms current-indices current-points)
166
(let ((old-forms (rest current-forms)))
167
(let* ((args (slime-ensure-list (slime-parse-sexp-at-point n)))
168
(arg-specs (mapcar #'slime-make-form-spec-from-string args)))
169
(setq current-forms (cons `(,name ,@arg-specs) old-forms))))
170
(values current-forms current-indices current-points)
118
(let ((old-forms (rest current-forms))
119
(arg-idx (first current-indices)))
120
(when (and (not (zerop arg-idx)) ; point is at CAR of form?
121
(not (= (point) ; point is at end of form?
123
(ignore-errors (slime-end-of-list))
125
(let* ((args (slime-parse-sexp-at-point n))
126
(arg-specs (mapcar #'slime-make-form-spec-from-string args)))
127
(setq current-forms (cons `(,name ,@arg-specs) old-forms))))
128
(values current-forms current-indices current-points)
173
131
(defun slime-parse-extended-operator/declare
174
132
(name user-point current-forms current-indices current-points)
338
295
(when (member (char-syntax (char-after)) '(?\( ?'))
341
(let ((name (slime-symbol-name-at-point)))
298
(let ((name (slime-symbol-at-point)))
344
301
(save-restriction
345
302
(widen) ; to allow looking-ahead/back in extended parsing.
346
303
(multiple-value-bind (new-result new-indices new-points)
347
(slime-parse-extended-operator-name initial-point
348
(cons `(,name) result) ; minimal form spec
349
(cons arg-index arg-indices)
350
(cons (point) points))
304
(slime-parse-extended-operator-name
306
(cons `(,name) result) ; minimal form spec
307
(cons arg-index arg-indices)
308
(cons (point) points))
351
309
(setq result new-result)
352
310
(setq arg-indices new-indices)
353
311
(setq points new-points))))
366
324
(if (listp thing) thing (list thing)))
368
326
(defun slime-inside-string-p ()
369
(let* ((toplevel-begin (save-excursion (beginning-of-defun) (point)))
370
(parse-result (parse-partial-sexp toplevel-begin (point)))
371
(inside-string-p (nth 3 parse-result))
372
(string-start-pos (nth 8 parse-result)))
373
(and inside-string-p string-start-pos)))
327
(nth 3 (slime-current-parser-state)))
375
329
(defun slime-beginning-of-string ()
376
(let ((string-start-pos (slime-inside-string-p)))
378
(goto-char string-start-pos)
379
(error "We're not within a string"))))
330
(let* ((parser-state (slime-current-parser-state))
331
(inside-string-p (nth 3 parser-state))
332
(string-start-pos (nth 8 parser-state)))
334
(goto-char string-start-pos)
335
(error "We're not within a string"))))
340
(defun slime-check-enclosing-form-specs (wished-form-specs)
342
(format "Enclosing form specs correct in `%s' (at %d)" (buffer-string) (point))
344
(first (slime-enclosing-form-specs))))
346
(def-slime-test enclosing-form-specs.1
347
(buffer-sexpr wished-form-specs)
348
"Check that we correctly determine enclosing forms."
349
'(("(defun *HERE*" (("defun")))
350
("(defun foo *HERE*" (("defun")))
351
("(defun foo (x y) *HERE*" (("defun")))
352
("(defmethod *HERE*" (("defmethod")))
353
("(defmethod foo *HERE*" (("defmethod" "foo")))
354
("(cerror foo *HERE*" (("cerror" "foo")))
355
("(cerror foo bar *HERE*" (("cerror" "foo" "bar")))
356
("(make-instance foo *HERE*" (("make-instance" "foo")))
357
("(apply 'foo *HERE*" (("apply" "'foo")))
358
("(apply #'foo *HERE*" (("apply" "#'foo")))
359
("(declare *HERE*" (("declare")))
360
("(declare (optimize *HERE*" ((:declaration ("optimize")) ("declare")))
361
("(declare (string *HERE*" ((:declaration ("string")) ("declare")))
362
("(declare ((vector *HERE*" ((:type-specifier ("vector"))))
363
("(declare ((vector bit *HERE*" ((:type-specifier ("vector" "bit")))))
364
(slime-check-top-level)
367
(insert buffer-sexpr)
368
(search-backward "*HERE*")
369
(delete-region (match-beginning 0) (match-end 0))
370
(slime-check-enclosing-form-specs wished-form-specs)
371
(insert ")") (backward-char)
372
(slime-check-enclosing-form-specs wished-form-specs)
381
377
(provide 'slime-parse)
added
removed
contrib/slime-parse.el
