Skip to content

Instantly share code, notes, and snippets.

@hchbaw
Created July 1, 2009 11:06
Show Gist options
  • Save hchbaw/138725 to your computer and use it in GitHub Desktop.
Save hchbaw/138725 to your computer and use it in GitHub Desktop.
(ns swank.commands.basic
(:refer-clojure :exclude [load-file])
(:use (swank util commands core)
(swank.util.concurrent thread)
(swank.util string clojure)
(swank.clj-contrib pprint macroexpand))
(:require (swank.util [sys :as sys]))
(:import (java.io StringReader File)
(java.util.zip ZipFile)
(clojure.lang LineNumberingPushbackReader)))
;;;; Connection
(defslimefn connection-info []
`(:pid ~(sys/get-pid)
:style :spawn
:lisp-implementation (:type "clojure" :name "clojure")
:package (:name ~(name (ns-name *ns*))
:prompt ~(name (ns-name *ns*)))
:version ~(deref *protocol-version*)))
(defslimefn quit-lisp []
(System/exit 0))
;;;; Evaluation
(defn- eval-region
"Evaluate string, return the results of the last form as a list and
a secondary value the last form."
([string]
(with-open [rdr (LineNumberingPushbackReader. (StringReader. string))]
(loop [form (read rdr false rdr), value nil, last-form nil]
(if (= form rdr)
[value last-form]
(recur (read rdr false rdr)
(eval form)
form))))))
(defslimefn interactive-eval-region [string]
(with-emacs-package
(pr-str (first (eval-region string)))))
(defslimefn interactive-eval [string]
(with-emacs-package
(pr-str (first (eval-region string)))))
(defslimefn listener-eval [form]
(with-emacs-package
(with-package-tracking
(let [[value last-form] (eval-region form)]
(when (and last-form (not (one-of? last-form '*1 '*2 '*3 '*e)))
(set! *3 *2)
(set! *2 *1)
(set! *1 value))
(send-repl-results-to-emacs value)))))
(defslimefn eval-and-grab-output [string]
(with-emacs-package
(with-local-vars [retval nil]
(list (with-out-str
(var-set retval (pr-str (first (eval-region string)))))
(var-get retval)))))
;;;; Macro expansion
(defn- apply-macro-expander [expander string]
(pretty-pr-code (expander (read-from-string string))))
(defslimefn swank-macroexpand-1 [string]
(apply-macro-expander macroexpand-1 string))
(defslimefn swank-macroexpand [string]
(apply-macro-expander macroexpand string))
;; not implemented yet, needs walker
(defslimefn swank-macroexpand-all [string]
(apply-macro-expander macroexpand-all string))
;;;; Compiler / Execution
(def *compiler-exception-location-re* #"^clojure\\.lang\\.Compiler\\$CompilerException: ([^:]+):([^:]+):")
(defn- guess-compiler-exception-location [#^Throwable t]
(when (instance? clojure.lang.Compiler$CompilerException t)
(let [[match file line] (re-find *compiler-exception-location-re* (.toString t))]
(when (and file line)
`(:location (:file ~file) (:line ~(Integer/parseInt line)) nil)))))
;; TODO: Make more and better guesses
(defn- exception-location [#^Throwable t]
(or (guess-compiler-exception-location t)
'(:error "No error location available")))
;; plist of message, severity, location, references, short-message
(defn- exception-to-message [#^Throwable t]
`(:message ~(.toString t)
:severity :error
:location ~(exception-location t)
:references nil
:short-message ~(.toString t)))
(defn- compile-file-for-emacs*
"Compiles a file for emacs. Because clojure doesn't compile, this is
simple an alias for load file w/ timing and messages. This function
is to reply with the following:
(:swank-compilation-unit notes results durations)"
([file-name]
(let [start (System/nanoTime)]
(try
(let [ret (clojure.core/load-file file-name)
delta (- (System/nanoTime) start)]
`(:compilation-result nil ~(pr-str ret) ~(/ delta 1000000000.0)))
(catch Throwable t
(let [delta (- (System/nanoTime) start)
causes (exception-causes t)
num (count causes)]
(.printStackTrace t) ;; prints to *inferior-lisp*
`(:compilation-result
~(map exception-to-message causes) ;; notes
nil ;; results
~(/ delta 1000000000.0) ;; durations
)))))))
(defslimefn compile-file-for-emacs
([file-name load? compile-options]
(when load?
(compile-file-for-emacs* file-name))))
(defslimefn load-file [file-name]
(pr-str (clojure.core/load-file file-name)))
(defslimefn compile-string-for-emacs [string buffer position directory debug]
(let [start (System/nanoTime)
ret (with-emacs-package (eval-region string))
delta (- (System/nanoTime) start)]
`(:compilation-result nil ~(pr-str ret) ~(/ delta 1000000000.0))))
;;;; Describe
(defn- describe-to-string [var]
(with-out-str
(print-doc var)))
(defn- describe-symbol* [symbol-name]
(with-emacs-package
(if-let [v (ns-resolve (maybe-ns *current-package*) (symbol symbol-name))]
(describe-to-string v)
(str "Unknown symbol " symbol-name))))
(defslimefn describe-symbol [symbol-name]
(describe-symbol* symbol-name))
(defslimefn describe-function [symbol-name]
(describe-symbol* symbol-name))
;; Only one namespace... so no kinds
(defslimefn describe-definition-for-emacs [name kind]
(describe-symbol* name))
;; Only one namespace... so only describe symbol
(defslimefn documentation-symbol
([symbol-name default] (documentation-symbol symbol-name))
([symbol-name] (describe-symbol* symbol-name)))
;;;; Documentation
(defn- briefly-describe-symbol-for-emacs [var]
(let [lines (fn [s] (seq (.split s "\n")))
[_ symbol-name arglists d1 d2 & __] (lines (describe-to-string var))
macro? (= d1 "Macro")]
(list :designator symbol-name
(cond
macro? :macro
(:arglists ^var) :function
:else :variable)
(apply str (concat arglists (if macro? d2 d1))))))
(defn- make-apropos-matcher [pattern case-sensitive?]
(let [pattern (java.util.regex.Pattern/quote pattern)
pat (re-pattern (if case-sensitive?
pattern
(format "(?i:%s)" pattern)))]
(fn [var] (re-find pat (pr-str var)))))
(defn- apropos-symbols [string external-only? case-sensitive? package]
(let [packages (or (when package [package]) (all-ns))
matcher (make-apropos-matcher string case-sensitive?)
lister (if external-only? ns-publics ns-interns)]
(filter matcher
(apply concat (map (comp (partial map second) lister)
packages)))))
(defslimefn apropos-list-for-emacs
([name]
(apropos-list-for-emacs name nil nil nil))
([name external-only?]
(apropos-list-for-emacs name external-only? nil nil))
([name external-only? case-sensitive?]
(apropos-list-for-emacs name external-only? case-sensitive? nil))
([name external-only? case-sensitive? package]
(let [package (when package
(or (find-ns (symbol package))
'clojure.core))]
(map briefly-describe-symbol-for-emacs
(sort
(fn [a b] (compare (str a) (str b)))
(apropos-symbols name external-only? case-sensitive? package))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment