Bob autodoc

src/swank/commands.clj

@@ -6,9 +6,15 @@
   ([fname & body]
      `(alter-var-root #'slime-fn-map
                       assoc
-                      (symbol "swank" ~(name fname))
+                      (symbol (str "swank:" ~(name fname)))
 		      (defn ~fname ~@body)))
   {:indent 'defun})
 
+(defn fq-symbol [sym]
+  (symbol (str "swank:" (name sym))))
+
 (defn slime-fn [sym]
-  (slime-fn-map (symbol "swank" (name sym))))
+  (slime-fn-map (fq-symbol sym)))
+
+(defn slime-fqfn [sym]
+  (slime-fn-map sym))

src/swank/commands/basic.clj

@@ -274,9 +274,9 @@ that symbols accessible in the current namespace go first."
        (symbol? f) (let [var (ns-resolve (maybe-ns package) f)]
                      (if-let [args (and var (:arglists (meta var)))]
                        (pr-str args)
-                       nil))
-       :else nil))
-    (catch Throwable t nil)))
+                      `:not-available))
+      :else `:not-available))
+   (catch Throwable t `:not-available)))
 
 ;;;; Package Commands
 

src/swank/commands/contrib/swank_arglists.clj

@@ -1,7 +1,7 @@
 (ns swank.commands.contrib.swank-arglists
-  (:use (swank util core commands)))
-
-((slime-fn 'swank-require) :swank-c-p-c)
+  (:refer-clojure :exclude [load-file])
+  (:use (swank util core commands)
+        (swank.commands basic)))
 
 (defslimefn arglist-for-echo-area [raw-specs & options]
   (let [{:keys [arg-indices
@@ -16,11 +16,36 @@
 
 (defslimefn variable-desc-for-echo-area [variable-name]
   (with-emacs-package
-   (or 
+   (or
     (try
      (when-let [sym (read-string variable-name)]
        (when-let [var (resolve sym)]
          (when (.isBound #^clojure.lang.Var var)
            (str variable-name " => " (var-get var)))))
      (catch Exception e nil))
     "")))
+
+
+(defn autodoc*
+  [raw-specs & options]
+  (let [{:keys [print-right-margin
+                print-lines]} (if (first options)
+                                (apply hash-map options)
+                                {})]
+    (if (and raw-specs
+             (seq? raw-specs))
+      (let [expr (some #(and (seq? %) (some #{:swank.rpc/cursor-marker} %) %)
+                       (tree-seq seq? seq raw-specs))]
+        (if (and (seq? expr) (not (= (first expr) "")))
+          ((slime-fn 'operator-arglist)
+           (first expr)
+           *current-package*)
+          `:not-available))
+      `:not-available)))
+
+(defslimefn autodoc
+  "Return a string representing the arglist for the deepest subform in
+RAW-FORM that does have an arglist.
+TODO: The highlighted parameter is wrapped in ===> X <===."
+  [raw-specs & options]
+  (apply autodoc* raw-specs options))

src/swank/core.clj

@@ -1,5 +1,5 @@
 (ns swank.core
-  (:use (swank util commands)
+  (:use (swank util commands rpc)
         (swank.util hooks)
         (swank.util.concurrent thread)
         (swank.core connection hooks threadmap))
@@ -232,7 +232,7 @@ values."
   (try
    (binding [*current-package* buffer-package
              *pending-continuations* (cons id *pending-continuations*)]
-     (if-let [f (slime-fn (first form))]
+     (if-let [f (slime-fqfn (first form))]
        (let [form (cons f (rest form))
              result (doall-seq (eval-in-emacs-package form))]
          (run-hook *pre-reply-hook*)
@@ -334,46 +334,62 @@ values."
      (with-connection conn
        (continuously (mb/send control (read-from-connection conn))))))
 
+(register-dispatch
+ :emacs-rex
+ (fn [conn ev]
+   (let [[action & args] ev
+	 [form-string package thread id] args
+	 thread (thread-for-evaluation thread conn)]
+     (mb/send thread `(eval-for-emacs ~form-string ~package ~id)))))
+
+(register-dispatch
+ :return
+ (fn [conn ev]
+   (let [[action & args] ev
+	 [thread & ret] args]
+     (binding [*print-level* nil, *print-length* nil]
+       (write-to-connection conn `(:return ~@ret))))))
+
+(doall (map
+	#(register-dispatch
+	  %
+	  (fn [conn ev]
+	    (binding [*print-level* nil, *print-length* nil]
+	      (write-to-connection conn ev))))
+	[:presentation-start :presentation-end
+	 :new-package :new-features :ed :percent-apply
+	 :indentation-update
+	 :eval-no-wait :background-message :inspect]))
+
+(register-dispatch
+ :write-string
+ (fn [conn ev]
+   (write-to-connection conn ev)))
+
+(doall (map
+	#(register-dispatch
+	  %
+	  (fn [conn ev]
+	    (let [[action & args] ev
+		  [thread & args] args]
+	      (write-to-connection conn `(~action ~(thread-map-id thread) ~@args)))))
+	[:debug :debug-condition :debug-activate :debug-return]))
+
+(register-dispatch
+ :emacs-interrupt
+ (fn [conn ev]
+   (let [[action & args] ev
+	 [thread & args] args]
+     (dosync
+      (cond
+       (and (true? thread) (seq @*active-threads*))
+       (.stop #^Thread (first @*active-threads*))
+       (= thread :repl-thread) (.stop #^Thread @(conn :repl-thread)))))))
+
 (defn dispatch-event
-   "Dispatches/executes an event in the control thread's mailbox queue."
-   ([ev conn]
-      (let [[action & args] ev]
-        (cond
-         (= action :emacs-rex)
-         (let [[form-string package thread id] args
-               thread (thread-for-evaluation thread conn)]
-           (mb/send thread `(eval-for-emacs ~form-string ~package ~id)))
-
-         (= action :return)
-         (let [[thread & ret] args]
-           (binding [*print-level* nil, *print-length* nil]
-             (write-to-connection conn `(:return ~@ret))))
-
-         (one-of? action
-                  :presentation-start :presentation-end
-                  :new-package :new-features :ed :percent-apply
-                  :indentation-update
-                  :eval-no-wait :background-message :inspect)
-         (binding [*print-level* nil, *print-length* nil]
-           (write-to-connection conn ev))
-
-         (= action :write-string)
-         (write-to-connection conn ev)
-
-         (one-of? action
-                  :debug :debug-condition :debug-activate :debug-return)
-         (let [[thread & args] args]
-           (write-to-connection conn `(~action ~(thread-map-id thread) ~@args)))
-
-         (= action :emacs-interrupt)
-         (let [[thread & args] args]
-           (dosync
-            (cond
-             (and (true? thread) (seq @*active-threads*))
-             (.stop #^Thread (first @*active-threads*))
-              (= thread :repl-thread) (.stop #^Thread @(conn :repl-thread)))))
-         :else
-         nil))))
+  "Dispatches/executes an event in the control thread's mailbox queue."
+  ([ev conn]
+     (dispatch-message conn ev)))
 
 ;; Main loop definitions
 (defn control-loop

src/swank/core/protocol.clj

@@ -12,6 +12,10 @@
    no pkg exists, then nothing is done."
   ([text] (.replaceAll (re-matcher *namespace-re* text) "$1/")))
 
+(defn- fix-cursor-marker
+  "Changes the cursor marker"
+  ([text] (.replace text "swank::%cursor-marker%" ":cursor-marker")))
+
 (defn write-swank-message
   "Given a `writer' (java.io.Writer) and a `message' (typically an
    sexp), encode the message according to the swank protocol and
@@ -27,20 +31,6 @@
    form (typically a sexp). This method will block until a message is
    completely transfered.
 
-   Note: This function will do some amount of Common Lisp -> clojure
-   conversions. This is due to the fact that several slime functions
-   like to treat everything it's talking to as a common lisp
-   implementation.
-     - If an :emacs-rex form is received and the first form contains a
-       common lisp package designation, this will convert it to use a
-       clojure designation.
-     - t will be converted to true
-
    See also `write-swank-message'."
   ([#^java.io.Reader reader]
-     (let [len  (Integer/parseInt (read-chars reader 6 read-fail-exception) 16)
-           msg  (read-chars reader len read-fail-exception)
-           form (read-string (fix-namespace msg))]
-       (if (seq? form)
-         (deep-replace {'t true} form)
-         form))))
+     (swank.rpc/decode-message reader)))