[slime-cvs] CVS slime/contrib

CVS User trittweiler trittweiler at common-lisp.net
Mon Mar 9 22:40:21 UTC 2009


Update of /project/slime/cvsroot/slime/contrib
In directory cl-net:/tmp/cvs-serv24536/contrib

Modified Files:
	ChangeLog slime-autodoc.el slime-enclosing-context.el 
Added Files:
	slime-indentation-fu.el swank-indentation-fu.lisp 
Log Message:
	* slime-autodoc.el (slime-compute-autodoc-rpc-form):
	New. Extracted from `slime-autodoc-thing-at-point'.
	(slime-compute-autodoc-internal): New. Extracted from
	`slime-compute-autodoc'.
	(slime-compute-autodoc): Explicitly save match data.
	(slime-autodoc-hook): New. Run everytime autodoc is computed.

	* slime-enclosing-context.el (slime-enclosing-bound-macros): New.
	(slime-find-bound-macros): New, too.

	* slime-indentation-fu.el, swank-indentation-fu.lisp: New contrib
	to properly indent &BODY arguments of local macro definitions.
	Suggested by Lorenz Moesenlechner.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2009/03/09 11:06:30	1.192
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2009/03/09 22:40:21	1.193
@@ -1,3 +1,19 @@
+2009-03-09  Tobias C. Rittweiler  <tcr at freebits.de>
+
+	* slime-autodoc.el (slime-compute-autodoc-rpc-form):
+	New. Extracted from `slime-autodoc-thing-at-point'.
+	(slime-compute-autodoc-internal): New. Extracted from
+	`slime-compute-autodoc'.
+	(slime-compute-autodoc): Explicitly save match data.
+	(slime-autodoc-hook): New. Run everytime autodoc is computed.
+
+	* slime-enclosing-context.el (slime-enclosing-bound-macros): New.
+	(slime-find-bound-macros): New, too.
+
+	* slime-indentation-fu.el, swank-indentation-fu.lisp: New contrib
+	to properly indent &BODY arguments of local macro definitions.
+	Suggested by Lorenz Moesenlechner.
+
 2009-03-09  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-kawa.scm: Use foo: style keywords because :foo is now
--- /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/02/27 21:38:20	1.14
+++ /project/slime/cvsroot/slime/contrib/slime-autodoc.el	2009/03/09 22:40:21	1.15
@@ -48,15 +48,19 @@
 ;;;; Autodocs (automatic context-sensitive help)
 
 (defun slime-autodoc-thing-at-point ()
+  "Not used; for debugging purposes."
+  (multiple-value-bind (operators arg-indices points)
+	    (slime-enclosing-form-specs)
+    (slime-compute-autodoc-rpc-form operators arg-indices points)))
+
+(defun slime-compute-autodoc-rpc-form (operators arg-indices points)
   "Return a cache key and a swank form."
   (let ((global (slime-autodoc-global-at-point)))
     (if global
         (values (slime-qualify-cl-symbol-name global)
                 `(swank:variable-desc-for-echo-area ,global))
-	(multiple-value-bind (operators arg-indices points)
-	    (slime-enclosing-form-specs)
-	  (values (slime-make-autodoc-cache-key operators arg-indices points)
-		  (slime-make-autodoc-swank-form operators arg-indices points))))))
+	(values (slime-make-autodoc-cache-key operators arg-indices points)
+                (slime-make-autodoc-swank-form operators arg-indices points)))))
 
 (defun slime-autodoc-global-at-point ()
   "Return the global variable name at point, if any."
@@ -192,24 +196,39 @@
 
 ;;;; slime-autodoc-mode
 
-(defun slime-compute-autodoc ()
+(defvar slime-autodoc-hook '()
+  "If autodoc is enabled, this hook is run periodically in the
+background everytime a new autodoc is computed. The hook is
+applied to the result of `slime-enclosing-form-specs'.")
+
+(defun slime-compute-autodoc-internal ()
   "Returns the cached arglist information as string, or nil.
 If it's not in the cache, the cache will be updated asynchronously."
-  (multiple-value-bind (cache-key retrieve-form) (slime-autodoc-thing-at-point)
-    (let ((cached (slime-get-cached-autodoc cache-key)))
-      (if cached
-	  cached
-          ;; If nothing is in the cache, we first decline, and fetch
-          ;; the arglist information asynchronously.
-          (prog1 nil
-            (slime-eval-async retrieve-form
-              (lexical-let ((cache-key cache-key)) 
-                (lambda (doc)
-                  (let ((doc (if doc (slime-format-autodoc doc) "")))
-                    ;; Now that we've got our information, get it to
-                    ;; the user ASAP.
-                    (eldoc-message doc)
-                    (slime-store-into-autodoc-cache cache-key doc))))))))))
+  (multiple-value-bind (ops arg-indices points)
+      (slime-enclosing-form-specs)
+    (run-hook-with-args 'slime-autodoc-hook ops arg-indices points)
+    (multiple-value-bind (cache-key retrieve-form)
+        (slime-compute-autodoc-rpc-form ops arg-indices points)
+      (let ((cached (slime-get-cached-autodoc cache-key)))
+        (if cached
+            cached
+            ;; If nothing is in the cache, we first decline, and fetch
+            ;; the arglist information asynchronously.
+            (prog1 nil
+              (slime-eval-async retrieve-form
+                (lexical-let ((cache-key cache-key)) 
+                  (lambda (doc)
+                    (let ((doc (if doc (slime-format-autodoc doc) "")))
+                      ;; Now that we've got our information, get it to
+                      ;; the user ASAP.
+                      (eldoc-message doc)
+                      (slime-store-into-autodoc-cache cache-key doc)))))))))))
+
+(defun slime-compute-autodoc ()
+  (save-excursion
+    (save-match-data
+      (slime-compute-autodoc-internal))))
+
 
 (make-variable-buffer-local (defvar slime-autodoc-mode nil))
 
@@ -260,6 +279,8 @@
 
 (slime-require :swank-arglists)
 
+
+
 ;;;; Test cases
 
 (defun slime-check-autodoc-at-point (arglist)
--- /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el	2009/02/27 17:37:14	1.5
+++ /project/slime/cvsroot/slime/contrib/slime-enclosing-context.el	2009/03/09 22:40:21	1.6
@@ -94,6 +94,15 @@
 	      (nreverse start-points)))))
 
 
+(defun slime-enclosing-bound-macros ()
+  (multiple-value-call #'slime-find-bound-macros (slime-enclosing-form-specs)))
+
+(defun slime-find-bound-macros (ops indices points)
+  ;; Kludgy!
+  (let ((slime-function-binding-ops-alist '((macrolet &bindings &body))))
+    (slime-find-bound-functions ops indices points)))
+
+
 (def-slime-test enclosing-context.1
     (buffer-sexpr wished-bound-names wished-bound-functions)
     "Check that finding local definitions work."

--- /project/slime/cvsroot/slime/contrib/slime-indentation-fu.el	2009/03/09 22:40:21	NONE
+++ /project/slime/cvsroot/slime/contrib/slime-indentation-fu.el	2009/03/09 22:40:21	1.1
;;; slime-indentation-fu.el --- Correct indentation of local macros.
;;
;; Author:  Tobias C. Rittweiler <tcr at freebits.de>
;;
;; License: GNU GPL (same license as Emacs)
;;

(require 'slime-autodoc)

(slime-require :swank-indentation-fu)

(defun slime-indentation-spec (arglist-string)
  (slime-eval `(swank:arglist-indentation ,arglist-string)))

(defun slime-enclosing-macro-arglist (name)
  (multiple-value-bind (macro-names arglists arglist-pts)
      (slime-enclosing-bound-macros)
    (when-let (pos (position name macro-names :test 'equal))
      (nth pos arglists))))

;;; This was copied straight from the aweful cruft that is
;;; cl-indent.el (Emacs 23.0.91.2)
(defun slime-compute-indentation-column
    (method path containing-form-start sexp-column normal-indent)
  (cond ((cdr path)
         normal-indent)
        ((<= (car path) method)
         ;; `distinguished' form
         (list (+ sexp-column 4)
               containing-form-start))
        ((= (car path) (1+ method))
         ;; first body form.
         (+ sexp-column lisp-body-indent))
        (t
         ;; other body form
         normal-indent)))

(defun slime-indent-fu (path state indent-point sexp-column normal-indent)
  (let* ((containing-form-start (nth 1 state))
         (form-operator 
          (save-excursion (goto-char (1+ containing-form-start))
                          (slime-symbol-at-point))))
    (assert form-operator)
    (let* ((local-arglist (slime-enclosing-macro-arglist form-operator))
           (indent-spec   (if local-arglist
                              (slime-indentation-spec local-arglist)
                              (get (intern-soft form-operator) 'slime-indent))))
      (slime-compute-indentation-column
       indent-spec path containing-form-start sexp-column normal-indent))))

(defun slime-update-local-indentation (ops arg-indices points)
  (loop for name in (car (slime-find-bound-macros ops arg-indices points)) do 
        (put (intern name) 'slime-local-indent t) 
        (put (intern name) 'common-lisp-indent-function 'slime-indent-fu)))

(defun slime-indentation-fu-init ()
  (add-hook 'slime-autodoc-hook 'slime-update-local-indentation))

(defun slime-indentation-fu-unload ()
  (remove-hook 'slime-autodoc-hook 'slime-update-local-indentation))


;;; Tests.

(def-slime-test local-indentation.1 (buffer-content)
        "Check that indentation of MACROLET bound macros work."
    '(("
\(in-package :swank)

\(defmacro zurp (x &body body)
  `(progn ,x , at body))

\(defun quux (foo)
  (zurp foo
    12
    *HERE1*
    14))

\(defun foo (x y)
  (let ((bar 42))
    (macrolet ((zurp (a b &body body)
                 `(progn ,a ,b , at body)))
      (zurp x
          y
        bar
        *HERE2*
        14))))"))
  (with-temp-buffer
    (lisp-mode)
    (slime-mode 1)
    (slime-autodoc-mode 1)
    (insert buffer-content)
    (slime-compile-region (point-min) (point-max))
    (search-backward "*HERE2*")
    (slime-compute-autodoc)             ; updates indentation implicitly
    (slime-sync-to-top-level 3)
    (beginning-of-defun)
    (indent-sexp)
    (search-backward "*HERE1*")
    (beginning-of-defun)
    (indent-sexp)
    (slime-test-expect "Correct buffer content"
                       buffer-content
                       (substring-no-properties (buffer-string))))  
  )

(provide 'slime-indentation-fu)--- /project/slime/cvsroot/slime/contrib/swank-indentation-fu.lisp	2009/03/09 22:40:21	NONE
+++ /project/slime/cvsroot/slime/contrib/swank-indentation-fu.lisp	2009/03/09 22:40:21	1.1

(in-package :swank)

(defslimefun arglist-indentation (arglist)
  (with-buffer-syntax ()
    (macro-indentation (from-string arglist))))

(provide :swank-indentation-fu)




More information about the slime-cvs mailing list