basic.clj

(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))))))