Browse files

Rename swank-clj to ritz

  • Loading branch information...
1 parent e209e68 commit baac7db5cc79ef490f2cf8b96d5822c8243939ec @hugoduncan hugoduncan committed Jul 2, 2011
Showing with 570 additions and 0 deletions.
  1. +44 −0 src/main/clojure/cake/tasks/ritz.clj
  2. +22 −0 src/main/clojure/leiningen/ritz.clj
  3. 0 src/main/clojure/{swank_clj → ritz}/clj_contrib/macroexpand.clj
  4. 0 src/main/clojure/{swank_clj → ritz}/commands/basic.clj
  5. 0 src/main/clojure/{swank_clj → ritz}/commands/completion.clj
  6. 0 src/main/clojure/{swank_clj → ritz}/commands/contrib.clj
  7. +98 −0 src/main/clojure/ritz/commands/contrib/ritz.clj
  8. 0 src/main/clojure/{swank_clj → ritz}/commands/contrib/swank_arglists.clj
  9. 0 src/main/clojure/{swank_clj → ritz}/commands/contrib/swank_c_p_c.clj
  10. 0 src/main/clojure/{swank_clj → ritz}/commands/contrib/swank_c_p_c/internal.clj
  11. 0 src/main/clojure/{swank_clj → ritz}/commands/contrib/swank_clj.clj
  12. 0 src/main/clojure/{swank_clj → ritz}/commands/contrib/swank_fuzzy.clj
  13. 0 src/main/clojure/{swank_clj → ritz}/commands/debugger.clj
  14. 0 src/main/clojure/{swank_clj → ritz}/commands/inspector.clj
  15. 0 src/main/clojure/{swank_clj → ritz}/commands/swank_arglists.clj
  16. 0 src/main/clojure/{swank_clj → ritz}/commands/swank_c_p_c.clj
  17. 0 src/main/clojure/{swank_clj → ritz}/commands/swank_c_p_c/internal.clj
  18. 0 src/main/clojure/{swank_clj → ritz}/commands/xref.clj
  19. 0 src/main/clojure/{swank_clj → ritz}/connection.clj
  20. 0 src/main/clojure/{swank_clj → ritz}/executor.clj
  21. 0 src/main/clojure/{swank_clj → ritz}/hooks.clj
  22. 0 src/main/clojure/{swank_clj → ritz}/inspect.clj
  23. 0 src/main/clojure/{swank_clj → ritz}/jpda/debug.clj
  24. 0 src/main/clojure/{swank_clj → ritz}/jpda/disassemble.clj
  25. 0 src/main/clojure/{swank_clj → ritz}/jpda/jdi.clj
  26. 0 src/main/clojure/{swank_clj → ritz}/jpda/jdi_clj.clj
  27. 0 src/main/clojure/{swank_clj → ritz}/jpda/jdi_vm.clj
  28. 0 src/main/clojure/{swank_clj → ritz}/logging.clj
  29. 0 src/main/clojure/{swank_clj → ritz}/main.clj
  30. 0 src/main/clojure/{swank_clj → ritz}/proxy.clj
  31. 0 src/main/clojure/{swank_clj → ritz}/repl.clj
  32. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/arglist.clj
  33. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/class_browse.clj
  34. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/clojure.clj
  35. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/compile.clj
  36. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/completion.clj
  37. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/doc.clj
  38. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/find.clj
  39. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/format.clj
  40. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/fuzzy_completion.clj
  41. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/helpers.clj
  42. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/java.clj
  43. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/mangle.clj
  44. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/sys.clj
  45. 0 src/main/clojure/{swank_clj → ritz}/repl_utils/trace.clj
  46. 0 src/main/clojure/{swank_clj → ritz}/rpc.clj
  47. 0 src/main/clojure/{swank_clj → ritz}/rpc_server.clj
  48. 0 src/main/clojure/{swank_clj → ritz}/rpc_socket_connection.clj
  49. 0 src/main/clojure/{swank_clj → ritz}/socket_server.clj
  50. 0 src/main/clojure/{swank_clj → ritz}/swank.clj
  51. 0 src/main/clojure/{swank_clj → ritz}/swank/cl.clj
  52. 0 src/main/clojure/{swank_clj → ritz}/swank/commands.clj
  53. 0 src/main/clojure/{swank_clj → ritz}/swank/core.clj
  54. 0 src/main/clojure/{swank_clj → ritz}/swank/indent.clj
  55. 0 src/main/clojure/{swank_clj → ritz}/swank/messages.clj
  56. 0 src/main/clojure/{swank_clj → ritz}/swank/utils.clj
  57. +262 −0 src/main/elisp/slime-ritz.el
  58. 0 src/test/clojure/{swank_clj → ritz}/commands/basic_test.clj
  59. 0 src/test/clojure/{swank_clj → ritz}/commands/completion_test.clj
  60. +51 −0 src/test/clojure/ritz/commands/contrib/ritz_test.clj
  61. 0 src/test/clojure/{swank_clj → ritz}/commands/contrib/swank_clj_test.clj
  62. 0 src/test/clojure/{swank_clj → ritz}/commands/contrib/swank_fuzzy_test.clj
  63. 0 src/test/clojure/{swank_clj → ritz}/commands/debugger_test.clj
  64. 0 src/test/clojure/{swank_clj → ritz}/commands/inspector_test.clj
  65. 0 src/test/clojure/{swank_clj → ritz}/connection_test.clj
  66. 0 src/test/clojure/{swank_clj → ritz}/inspect_test.clj
  67. 0 src/test/clojure/{swank_clj → ritz}/jpda/debug_test.clj
  68. 0 src/test/clojure/{swank_clj → ritz}/jpda/disassemble_test.clj
  69. 0 src/test/clojure/{swank_clj → ritz}/jpda/jdi_clj_test.clj
  70. +76 −0 src/test/clojure/ritz/jpda/jdi_test_handler.clj
  71. 0 src/test/clojure/{swank_clj → ritz}/jpda/jdi_vm_test.clj
  72. 0 src/test/clojure/{swank_clj → ritz}/proxy_test.clj
  73. 0 src/test/clojure/{swank_clj → ritz}/repl_utils/arglist_test.clj
  74. 0 src/test/clojure/{swank_clj → ritz}/repl_utils/class_browse_test.clj
  75. 0 src/test/clojure/{swank_clj → ritz}/repl_utils/completion_test.clj
  76. 0 src/test/clojure/{swank_clj → ritz}/repl_utils/doc_test.clj
  77. 0 src/test/clojure/{swank_clj → ritz}/repl_utils/find_test.clj
  78. 0 src/test/clojure/{swank_clj → ritz}/repl_utils/format_test.clj
  79. 0 src/test/clojure/{swank_clj → ritz}/repl_utils/fuzzy_completion_test.clj
  80. 0 src/test/clojure/{swank_clj → ritz}/repl_utils/mangle_test.clj
  81. 0 src/test/clojure/{swank_clj → ritz}/repl_utils/trace_test.clj
  82. 0 src/test/clojure/{swank_clj → ritz}/rpc_server_test.clj
  83. 0 src/test/clojure/{swank_clj → ritz}/rpc_test.clj
  84. 0 src/test/clojure/{swank_clj → ritz}/swank/core_test.clj
  85. 0 src/test/clojure/{swank_clj → ritz}/swank/indent_test.clj
  86. 0 src/test/clojure/{swank_clj → ritz}/swank/utils_test.clj
  87. 0 src/test/clojure/{swank_clj → ritz}/swank_test.clj
  88. 0 src/test/clojure/{swank_clj → ritz}/test_utils.clj
  89. +17 −0 update-slime-ritz-package-version.sh
View
44 src/main/clojure/cake/tasks/ritz.clj
@@ -0,0 +1,44 @@
+(ns cake.tasks.ritz
+ "A cake task for running ritz. Modified from cake.tasks.swank."
+ (:use cake cake.core
+ [useful.utils :only [if-ns]]
+ [bake.core :only [current-context]]))
+
+(def current-port (atom nil))
+
+(defn- serve-swank
+ "Run ritz connection thread in the project classloader."
+ [context options]
+ (bake (:use [bake.core :only [set-context!]])
+ (:require ritz.socket-server)
+ [context context options options]
+ (let [start (ns-resolve 'ritz.socket-server 'start)
+ opts {:encoding (or (System/getProperty "swank.encoding")
+ "iso-latin-1-unix")}]
+ (eval (:swank-init *project*))
+ (set-context! context)
+ (start (merge opts options)))))
+
+(if-ns (:use [ritz.socket-server :only [start]])
+
+ (defn start-swank [options]
+ (let [out (with-out-str (serve-swank (current-context) options))]
+ (if (.contains out "java.net.BindException")
+ (println "unable to start swank-clojure server, port already in use")
+ (do (compare-and-set! current-port nil (:port options))
+ (println "started swank-clojure server on port" @current-port)))))
+
+ (defn start-swank [host]
+ (println "error loading ritz.")
+ (println
+ "see http://clojure-cake.org/swank for installation instructions")))
+
+(deftask ritz #{compile-java}
+ "Report status of ritz server and start it if not running."
+ {opts :ritz}
+ (if @current-port
+ (println "ritz currently running on port" @current-port)
+ (let [[host port & {:as options}] opts]
+ (start-swank (merge {:host (or host "localhost")
+ :port (or port 4005)}
+ options)))))
View
22 src/main/clojure/leiningen/ritz.clj
@@ -0,0 +1,22 @@
+(ns leiningen.ritz
+ (:use [leiningen.compile :only [eval-in-project]]))
+
+(defn ritz
+ "Launch swank server for Emacs to connect. Optionally takes PORT and HOST."
+ ([project port host & {:as opts}]
+ (eval-in-project
+ project
+ `(do (require '~'ritz.socket-server)
+ (import '~'java.io.File)
+ (binding [*compile-path* ~(.getAbsolutePath
+ (java.io.File.
+ (or (:compile-path project)
+ "./classes")))]
+ (@(ns-resolve '~'ritz.socket-server '~'start)
+ '~(merge
+ (zipmap
+ (map read-string (keys opts))
+ (map read-string (vals opts)))
+ {:port (Integer. port) :host host}))))))
+ ([project port] (ritz project port "localhost"))
+ ([project] (ritz project 4005)))
View
0 ...ure/swank_clj/clj_contrib/macroexpand.clj → .../clojure/ritz/clj_contrib/macroexpand.clj
File renamed without changes.
View
0 ...main/clojure/swank_clj/commands/basic.clj → src/main/clojure/ritz/commands/basic.clj
File renamed without changes.
View
0 ...clojure/swank_clj/commands/completion.clj → ...main/clojure/ritz/commands/completion.clj
File renamed without changes.
View
0 ...in/clojure/swank_clj/commands/contrib.clj → src/main/clojure/ritz/commands/contrib.clj
File renamed without changes.
View
98 src/main/clojure/ritz/commands/contrib/ritz.clj
@@ -0,0 +1,98 @@
+(ns ritz.commands.contrib.ritz
+ "Contrib for providing ritz specific functions"
+ (:use
+ [ritz.swank.commands :only [defslimefn]])
+ (:require
+ [clojure.string :as string]
+ [clojure.java.javadoc :as javadoc]
+ [ritz.connection :as connection]
+ [ritz.jpda.debug :as debug]
+ [ritz.logging :as logging]
+ [ritz.repl-utils.doc :as doc]
+ [ritz.repl-utils.find :as find]
+ [ritz.swank.messages :as messages]))
+
+;;; Breakpoints
+
+(defslimefn line-breakpoint
+ "Set a breakpoint at the specified line. Updates the vm-context in the
+ connection."
+ [connection namespace filename line]
+ (let [context (:vm-context @connection)
+ n (count (:breakpoints @context))
+ new-context (swap!
+ context debug/line-breakpoint namespace filename line)]
+ (format
+ "Set %d breakpoints"
+ (- (count (:breakpoints new-context)) n))))
+
+;; (defslimefn break-on-exceptions
+;; "Control which expressions are trapped in the debugger"
+;; [connection filter-caught? class-exclusions])
+
+(defslimefn quit-breakpoint-browser [connection])
+
+
+(def ^{:private true} breakpoint-data-fn
+ (comp
+ seq
+ (juxt #(:id % "")
+ :file
+ :line
+ :enabled)))
+
+(defslimefn list-breakpoints [connection]
+ "Return a list (LABELS (ID FILE LINE ENABLED ATTRS ...) ...).
+LABELS is a list of attribute names and the remaining lists are the
+corresponding attribute values per thread."
+ [connection]
+ (let [context (swap! (:vm-context @connection) debug/breakpoint-list)
+ breakpoints (:breakpoints context)
+ labels '(:id :file :line :enabled)]
+ (cons labels (map breakpoint-data-fn breakpoints))))
+
+(defslimefn breakpoint-kill
+ [connection breakpoint-id]
+ (debug/breakpoint-kill (connection/vm-context connection) breakpoint-id))
+
+(defslimefn breakpoint-enable
+ [connection breakpoint-id]
+ (debug/breakpoint-enable (connection/vm-context connection) breakpoint-id))
+
+(defslimefn breakpoint-disable
+ [connection breakpoint-id]
+ (debug/breakpoint-disable (connection/vm-context connection) breakpoint-id))
+
+(defslimefn breakpoint-location
+ [connection breakpoint-id]
+ (messages/location
+ (debug/breakpoint-location
+ (connection/vm-context connection) breakpoint-id)))
+
+;;; javadoc
+(defslimefn javadoc-local-paths
+ [connection & paths]
+ (doc/javadoc-local-paths paths)
+ nil)
+
+(defslimefn javadoc-url
+ [connection symbol-name]
+ (doc/javadoc-url symbol-name))
+
+;;; list repl source forms
+(defslimefn list-repl-source-forms
+ "List all the source forms entered in the REPL"
+ [connection]
+ (string/join \newline (find/source-forms)))
+
+;;; swank development utilities
+(defslimefn toggle-swank-logging
+ "Control logging level"
+ [connection]
+ (swap! logging/log-level (fn [lvl] (if lvl nil :trace))))
+
+(defslimefn resume-vm
+ "Resume the vm. If the vm becomes suspended for some reason, you can
+ use this to unsuspend it"
+ [connection]
+ (.resume (:vm (connection/vm-context connection))))
View
0 ...k_clj/commands/contrib/swank_arglists.clj → .../ritz/commands/contrib/swank_arglists.clj
File renamed without changes.
View
0 ...wank_clj/commands/contrib/swank_c_p_c.clj → ...ure/ritz/commands/contrib/swank_c_p_c.clj
File renamed without changes.
View
0 ...commands/contrib/swank_c_p_c/internal.clj → ...commands/contrib/swank_c_p_c/internal.clj
File renamed without changes.
View
0 .../swank_clj/commands/contrib/swank_clj.clj → ...ojure/ritz/commands/contrib/swank_clj.clj
File renamed without changes.
View
0 ...wank_clj/commands/contrib/swank_fuzzy.clj → ...ure/ritz/commands/contrib/swank_fuzzy.clj
File renamed without changes.
View
0 ...n/clojure/swank_clj/commands/debugger.clj → src/main/clojure/ritz/commands/debugger.clj
File renamed without changes.
View
0 .../clojure/swank_clj/commands/inspector.clj → src/main/clojure/ritz/commands/inspector.clj
File renamed without changes.
View
0 ...ure/swank_clj/commands/swank_arglists.clj → .../clojure/ritz/commands/swank_arglists.clj
File renamed without changes.
View
0 ...lojure/swank_clj/commands/swank_c_p_c.clj → ...ain/clojure/ritz/commands/swank_c_p_c.clj
File renamed without changes.
View
0 ...ank_clj/commands/swank_c_p_c/internal.clj → ...re/ritz/commands/swank_c_p_c/internal.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/commands/xref.clj → src/main/clojure/ritz/commands/xref.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/connection.clj → src/main/clojure/ritz/connection.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/executor.clj → src/main/clojure/ritz/executor.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/hooks.clj → src/main/clojure/ritz/hooks.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/inspect.clj → src/main/clojure/ritz/inspect.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/jpda/debug.clj → src/main/clojure/ritz/jpda/debug.clj
File renamed without changes.
View
0 ...in/clojure/swank_clj/jpda/disassemble.clj → src/main/clojure/ritz/jpda/disassemble.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/jpda/jdi.clj → src/main/clojure/ritz/jpda/jdi.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/jpda/jdi_clj.clj → src/main/clojure/ritz/jpda/jdi_clj.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/jpda/jdi_vm.clj → src/main/clojure/ritz/jpda/jdi_vm.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/logging.clj → src/main/clojure/ritz/logging.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/main.clj → src/main/clojure/ritz/main.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/proxy.clj → src/main/clojure/ritz/proxy.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/repl.clj → src/main/clojure/ritz/repl.clj
File renamed without changes.
View
0 .../clojure/swank_clj/repl_utils/arglist.clj → src/main/clojure/ritz/repl_utils/arglist.clj
File renamed without changes.
View
0 ...ure/swank_clj/repl_utils/class_browse.clj → .../clojure/ritz/repl_utils/class_browse.clj
File renamed without changes.
View
0 .../clojure/swank_clj/repl_utils/clojure.clj → src/main/clojure/ritz/repl_utils/clojure.clj
File renamed without changes.
View
0 .../clojure/swank_clj/repl_utils/compile.clj → src/main/clojure/ritz/repl_utils/compile.clj
File renamed without changes.
View
0 ...ojure/swank_clj/repl_utils/completion.clj → ...in/clojure/ritz/repl_utils/completion.clj
File renamed without changes.
View
0 ...main/clojure/swank_clj/repl_utils/doc.clj → src/main/clojure/ritz/repl_utils/doc.clj
File renamed without changes.
View
0 ...ain/clojure/swank_clj/repl_utils/find.clj → src/main/clojure/ritz/repl_utils/find.clj
File renamed without changes.
View
0 ...n/clojure/swank_clj/repl_utils/format.clj → src/main/clojure/ritz/repl_utils/format.clj
File renamed without changes.
View
0 ...swank_clj/repl_utils/fuzzy_completion.clj → ...jure/ritz/repl_utils/fuzzy_completion.clj
File renamed without changes.
View
0 .../clojure/swank_clj/repl_utils/helpers.clj → src/main/clojure/ritz/repl_utils/helpers.clj
File renamed without changes.
View
0 ...ain/clojure/swank_clj/repl_utils/java.clj → src/main/clojure/ritz/repl_utils/java.clj
File renamed without changes.
View
0 ...n/clojure/swank_clj/repl_utils/mangle.clj → src/main/clojure/ritz/repl_utils/mangle.clj
File renamed without changes.
View
0 ...main/clojure/swank_clj/repl_utils/sys.clj → src/main/clojure/ritz/repl_utils/sys.clj
File renamed without changes.
View
0 ...in/clojure/swank_clj/repl_utils/trace.clj → src/main/clojure/ritz/repl_utils/trace.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/rpc.clj → src/main/clojure/ritz/rpc.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/rpc_server.clj → src/main/clojure/ritz/rpc_server.clj
File renamed without changes.
View
0 ...ojure/swank_clj/rpc_socket_connection.clj → ...in/clojure/ritz/rpc_socket_connection.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/socket_server.clj → src/main/clojure/ritz/socket_server.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/swank.clj → src/main/clojure/ritz/swank.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/swank/cl.clj → src/main/clojure/ritz/swank/cl.clj
File renamed without changes.
View
0 ...main/clojure/swank_clj/swank/commands.clj → src/main/clojure/ritz/swank/commands.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/swank/core.clj → src/main/clojure/ritz/swank/core.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/swank/indent.clj → src/main/clojure/ritz/swank/indent.clj
File renamed without changes.
View
0 ...main/clojure/swank_clj/swank/messages.clj → src/main/clojure/ritz/swank/messages.clj
File renamed without changes.
View
0 src/main/clojure/swank_clj/swank/utils.clj → src/main/clojure/ritz/swank/utils.clj
File renamed without changes.
View
262 src/main/elisp/slime-ritz.el
@@ -0,0 +1,262 @@
+;;; slime-ritz.el --- slime extensions for ritz
+;;
+;; Copyright 2011 Hugo Duncan
+;;
+;; Author: Hugo Duncan <hugo_duncan@yahoo.com>
+;; Keywords: languages, lisp, slime
+;; URL: https://github.com/pallet/ritz
+;; Version: 0.1.6
+;; License: EPL
+
+(define-slime-contrib slime-ritz
+ "Integration with ritz features"
+ (:authors "Hugo Duncan <hugo_duncan@yahoo.com>")
+ (:license "EPL")
+ (:on-load
+ (define-key slime-mode-map "\C-c\C-x\C-b" 'slime-line-breakpoint)))
+
+(defun slime-line-breakpoint ()
+ "Set a breakpoint at the current line"
+ (interactive)
+ (slime-eval-with-transcript
+ `(swank:line-breakpoint
+ ,(slime-current-package) ,(buffer-name) ,(line-number-at-pos))))
+
+;;;; Breakpoints
+(defvar slime-breakpoints-buffer-name (slime-buffer-name :breakpoints))
+
+(defun slime-list-breakpoints ()
+ "Display a list of breakpoints."
+ (interactive)
+ (let ((name slime-breakpoints-buffer-name))
+ (slime-with-popup-buffer (name :connection t
+ :mode 'slime-breakpoint-control-mode)
+ (slime-update-breakpoints-buffer)
+ (goto-char (point-min))
+ (setq slime-popup-buffer-quit-function 'slime-quit-breakpoints-buffer))))
+
+(defvar slime-breakpoint-index-to-id nil)
+
+(defun slime-quit-breakpoints-buffer (&optional _)
+ (slime-popup-buffer-quit t)
+ (setq slime-breakpoint-index-to-id nil)
+ (slime-eval-async `(swank:quit-breakpoint-browser)))
+
+(defun slime-update-breakpoints-buffer ()
+ (interactive)
+ (with-current-buffer slime-breakpoints-buffer-name
+ (slime-eval-async '(swank:list-breakpoints)
+ 'slime-display-breakpoints)))
+
+(defun slime-display-breakpoints (breakpoints)
+ (with-current-buffer slime-breakpoints-buffer-name
+ (let* ((inhibit-read-only t)
+ (index (get-text-property (point) 'breakpoint-id))
+ (old-breakpoint-id (and (numberp index)
+ (elt slime-breakpoint-index-to-id index)))
+ (old-line (line-number-at-pos))
+ (old-column (current-column)))
+ (setq slime-breakpoint-index-to-id (mapcar 'car (cdr breakpoints)))
+ (erase-buffer)
+ (slime-insert-breakpoints breakpoints)
+ (let ((new-position (position old-breakpoint-id breakpoints :key 'car)))
+ (goto-char (point-min))
+ (forward-line (1- (or new-position old-line)))
+ (move-to-column old-column)
+ (slime-move-point (point))))))
+
+(defvar *slime-breakpoints-table-properties*
+ '(nil (face bold)))
+
+(defun slime-format-breakpoints-labels (breakpoints)
+ (let ((labels (mapcar (lambda (x)
+ (capitalize (substring (symbol-name x) 1)))
+ (car breakpoints))))
+ (cons labels (cdr breakpoints))))
+
+(defun slime-insert-breakpoint (breakpoint longest-lines)
+ (unless (bolp) (insert "\n"))
+ (loop for i from 0
+ for align in longest-lines
+ for element in breakpoint
+ for string = (prin1-to-string element t)
+ for property = (nth i *slime-breakpoints-table-properties*)
+ do
+ (if property
+ (slime-insert-propertized property string)
+ (insert string))
+ (insert-char ?\ (- align (length string) -3))))
+
+(defun slime-insert-breakpoints (breakpoints)
+ (let* ((breakpoints (slime-format-breakpoints-labels breakpoints))
+ (longest-lines (slime-longest-lines breakpoints))
+ (labels (let (*slime-breakpoints-table-properties*)
+ (with-temp-buffer
+ (slime-insert-breakpoint (car breakpoints) longest-lines)
+ (buffer-string)))))
+ (if (boundp 'header-line-format)
+ (setq header-line-format
+ (concat (propertize " " 'display '((space :align-to 0)))
+ labels))
+ (insert labels))
+ (loop for index from 0
+ for breakpoint in (cdr breakpoints)
+ do
+ (slime-propertize-region `(breakpoint-id ,index)
+ (slime-insert-breakpoint breakpoint longest-lines)))))
+
+;;;;; Major mode
+
+(define-derived-mode slime-breakpoint-control-mode fundamental-mode
+ "Breakpoints"
+ "SLIME Breakpoint Control Panel Mode.
+
+\\{slime-breakpoint-control-mode-map}
+\\{slime-popup-buffer-mode-map}"
+ (when slime-truncate-lines
+ (set (make-local-variable 'truncate-lines) t))
+ (setq buffer-undo-list t))
+
+(slime-define-keys slime-breakpoint-control-mode-map
+ ("d" 'slime-breakpoint-disable)
+ ("e" 'slime-breakpoint-enable)
+ ("g" 'slime-update-breakpoints-buffer)
+ ("k" 'slime-breakpoint-kill)
+ ("v" 'slime-breakpoint-view))
+
+(defun slime-breakpoint-kill ()
+ (interactive)
+ (slime-eval `(swank:breakpoint-kill
+ ,@(slime-get-properties 'breakpoint-id)))
+ (call-interactively 'slime-update-breakpoints-buffer))
+
+(defun slime-get-region-properties (prop start end)
+ (loop for position = (if (get-text-property start prop)
+ start
+ (next-single-property-change start prop))
+ then (next-single-property-change position prop)
+ while (<= position end)
+ collect (get-text-property position prop)))
+
+(defun slime-get-properties (prop)
+ (if (use-region-p)
+ (slime-get-region-properties prop
+ (region-beginning)
+ (region-end))
+ (let ((value (get-text-property (point) prop)))
+ (when value
+ (list value)))))
+
+(defun slime-breakpoint-disable ()
+ (interactive)
+ (let ((id (get-text-property (point) 'breakpoint-id)))
+ (slime-eval-async `(swank:breakpoint-disable ,id)))
+ (call-interactively 'slime-update-breakpoints-buffer))
+
+(defun slime-breakpoint-enable ()
+ (interactive)
+ (let ((id (get-text-property (point) 'breakpoint-id)))
+ (slime-eval-async `(swank:breakpoint-enable ,id)))
+ (call-interactively 'slime-update-breakpoints-buffer))
+
+(defun slime-breakpoint-view ()
+ (interactive)
+ (let ((id (get-text-property (point) 'breakpoint-id)))
+ (slime-eval-async
+ `(swank:breakpoint-location ,id)
+ #'slime-show-source-location)))
+
+(def-slime-selector-method ?b
+ "SLIME Breakpoints buffer"
+ (slime-list-breakpoints)
+ slime-breakpoints-buffer-name)
+
+;;; repl forms
+(defun slime-list-repl-forms ()
+ "List the source forms"
+ (interactive)
+ (slime-eval-async `(swank:list-repl-source-forms)
+ (lambda (result)
+ (slime-show-description result nil))))
+
+;;; swank development helpers
+(defun slime-toggle-swank-logging ()
+ "Toggle logging in swank"
+ (interactive)
+ (slime-eval-with-transcript
+ `(swank:toggle-swank-logging)))
+
+(defun slime-resume-vm ()
+ "Resume a suspended vm"
+ (interactive)
+ (slime-eval-with-transcript
+ `(swank:resume-vm)))
+
+;;; javadoc browsing
+(defun slime-javadoc-local-paths (local-paths)
+ "Require JavaDoc namespace, adding a list of local paths."
+ (slime-eval-async `(swank:javadoc-local-paths ,@local-paths)))
+
+(defun slime-javadoc (symbol-name)
+ "Browse javadoc on the Java class at point."
+ (interactive (list (slime-read-symbol-name "Javadoc for: ")))
+ (when (not symbol-name)
+ (error "No symbol given"))
+ (slime-eval-async `(swank:javadoc-url ,symbol-name)
+ (lambda (url)
+ (if url
+ (browse-url url)
+ (error "No javadoc url for %S" url)))))
+
+;;; Initialization
+(defcustom slime-ritz-connected-hook nil
+ "List of functions to call when SLIME connects to clojure."
+ :type 'hook
+ :group 'slime-lisp)
+
+(defcustom slime-ritz-repl-mode-hook nil
+ "List of functions to call when a SLIME clojure repl starts."
+ :type 'hook
+ :group 'slime-lisp)
+
+(defun slime-connection-is-clojure-p ()
+ (compare-strings "clojure" 0 7 (slime-connection-name) 0 7))
+
+(defun slime-ritz-init ()
+ "Initialise slime-ritz. Creates clojure specific slime hooks."
+ (add-hook
+ 'slime-connected-hook
+ (lambda ()
+ (slime-ritz-bind-keys)
+ (when (slime-connection-is-clojure-p)
+ (run-hooks 'slime-ritz-connected-hook))))
+ (add-hook
+ 'slime-repl-mode-hook
+ (lambda ()
+ (when (slime-connection-is-clojure-p)
+ (run-hooks 'slime-ritz-repl-mode-hook)))))
+
+(add-hook 'slime-ritz-connected-hook 'slime-clojure-connection-setup)
+(add-hook 'slime-ritz-repl-mode-hook 'slime-clojure-repl-setup)
+
+(defun slime-clojure-connection-setup ()
+ (slime-ritz-bind-keys))
+
+(defun slime-clojure-repl-setup ()
+ (slime-ritz-bind-repl-keys))
+
+(defun slime-ritz-bind-keys ()
+ (define-key slime-mode-map "\C-c\C-x\C-b" 'slime-line-breakpoint)
+ (define-key slime-mode-map (kbd "C-c b") 'slime-javadoc))
+
+(defun slime-ritz-bind-repl-keys ()
+ (define-key slime-repl-mode-map (kbd "C-c b") 'slime-javadoc))
+
+;;;###autoload
+(add-hook 'slime-load-hook
+ (lambda ()
+ (require 'slime-ritz)
+ (slime-ritz-init)))
+
+(provide 'slime-ritz)
+;;; slime-ritz.el ends here
View
0 ...clojure/swank_clj/commands/basic_test.clj → ...test/clojure/ritz/commands/basic_test.clj
File renamed without changes.
View
0 ...re/swank_clj/commands/completion_test.clj → ...clojure/ritz/commands/completion_test.clj
File renamed without changes.
View
51 src/test/clojure/ritz/commands/contrib/ritz_test.clj
@@ -0,0 +1,51 @@
+(ns ritz.commands.contrib.ritz-test
+ (:use
+ [ritz.logging :as logging]
+ [ritz.commands.contrib.ritz :as sc]
+ [ritz.jpda.jdi-vm :as jdi-vm]
+ clojure.test)
+ (:require
+ [ritz.test-utils :as test-utils]))
+
+(def file *file*)
+
+(deftest breakpoint-test
+ (let [context (jdi-vm/launch-vm
+ (jdi-vm/current-classpath)
+ `(do
+ (require '~'ritz.commands.contrib.ritz-test)
+ (println (str '~'hi)))
+ :out *out*)]
+ (Thread/sleep 1000)
+ (->>
+ {:vm-context (atom context)}
+ (test-utils/eval-for-emacs-test
+ `(~'swank/list-breakpoints)
+ "00002e(:return (:ok ((:id :file :line :enabled))) 1)")
+ ;; (test-utils/eval-for-emacs-test
+ ;; `(~'swank/line-breakpoint
+ ;; "ritz.commands.contrib.ritz-test"
+ ;; ~file
+ ;; 12)
+ ;; "000025(:return (:ok \"Set 1 breakpoints\") 1)")
+ (test-utils/eval-for-emacs-test
+ `(~'swank/list-breakpoints)
+ "00002e(:return (:ok ((:id :file :line :enabled))) 1)")
+ (test-utils/eval-for-emacs-test
+ `(~'swank/breakpoint-disable 0)
+ "000015(:return (:ok nil) 1)")
+ (test-utils/eval-for-emacs-test
+ `(~'swank/list-breakpoints)
+ "00002e(:return (:ok ((:id :file :line :enabled))) 1)")
+ (test-utils/eval-for-emacs-test
+ `(~'swank/breakpoint-enable 0)
+ "000015(:return (:ok nil) 1)")
+ (test-utils/eval-for-emacs-test
+ `(~'swank/list-breakpoints)
+ "00002e(:return (:ok ((:id :file :line :enabled))) 1)")
+ (test-utils/eval-for-emacs-test
+ `(~'swank/breakpoint-kill 0)
+ "000015(:return (:ok nil) 1)")
+ (test-utils/eval-for-emacs-test
+ `(~'swank/list-breakpoints)
+ "00002e(:return (:ok ((:id :file :line :enabled))) 1)"))))
View
0 ...k_clj/commands/contrib/swank_clj_test.clj → .../ritz/commands/contrib/swank_clj_test.clj
File renamed without changes.
View
0 ...clj/commands/contrib/swank_fuzzy_test.clj → ...itz/commands/contrib/swank_fuzzy_test.clj
File renamed without changes.
View
0 ...jure/swank_clj/commands/debugger_test.clj → ...t/clojure/ritz/commands/debugger_test.clj
File renamed without changes.
View
0 ...ure/swank_clj/commands/inspector_test.clj → .../clojure/ritz/commands/inspector_test.clj
File renamed without changes.
View
0 ...est/clojure/swank_clj/connection_test.clj → src/test/clojure/ritz/connection_test.clj
File renamed without changes.
View
0 src/test/clojure/swank_clj/inspect_test.clj → src/test/clojure/ritz/inspect_test.clj
File renamed without changes.
View
0 ...est/clojure/swank_clj/jpda/debug_test.clj → src/test/clojure/ritz/jpda/debug_test.clj
File renamed without changes.
View
0 ...ojure/swank_clj/jpda/disassemble_test.clj → ...st/clojure/ritz/jpda/disassemble_test.clj
File renamed without changes.
View
0 ...t/clojure/swank_clj/jpda/jdi_clj_test.clj → src/test/clojure/ritz/jpda/jdi_clj_test.clj
File renamed without changes.
View
76 src/test/clojure/ritz/jpda/jdi_test_handler.clj
@@ -0,0 +1,76 @@
+(ns ritz.jpda.jdi-test-handler
+ "Provides a JDI event handler for testing"
+ (:require
+ [ritz.logging :as logging]
+ [ritz.jpda.jdi :as jdi]
+ [clojure.string :as string])
+ (:import
+ com.sun.jdi.event.BreakpointEvent
+ com.sun.jdi.event.ExceptionEvent
+ com.sun.jdi.event.StepEvent
+ com.sun.jdi.request.ExceptionRequest
+ com.sun.jdi.event.VMStartEvent
+ com.sun.jdi.event.VMDeathEvent
+ com.sun.jdi.event.Event
+ com.sun.jdi.VirtualMachine
+ com.sun.jdi.ObjectReference
+ (com.sun.jdi
+ Value BooleanValue ByteValue CharValue DoubleValue FloatValue IntegerValue
+ LongValue ShortValue))
+ (:use clojure.test))
+
+(def handlers (atom {}))
+
+(defn add-one-shot-event-handler
+ "Add an event handler for the specified thread name. The passed function
+ should accept an event and a context parameter, and is called only one
+ time, on a new thread."
+ [f thread-name]
+ (swap! handlers assoc thread-name [f {:atom (atom false)
+ :bindings
+ [*out* *err* *in* *test-out*
+ *report-counters*
+ *testing-contexts*
+ *stack-trace-depth*]}]))
+
+(defn add-event-handler
+ "Add an event handler for the specified thread name. The passed function
+ should accept an event and a context parameter."
+ [f thread-name]
+ (swap! handlers assoc thread-name [f {:bindings
+ [*out* *err* *in* *test-out*
+ *report-counters*
+ *testing-contexts*
+ *stack-trace-depth*]}]))
+
+(defmethod jdi/handle-event ExceptionEvent
+ [^Event event context]
+ (logging/trace "test handler EVENT %s" event)
+ (try
+ (let [thread (jdi/event-thread event)]
+ (logging/trace "test handler has thread")
+ (if-let [[f options] (@handlers (.name thread))]
+ (if-let [f-atom (:atom options)]
+ (if (compare-and-set! f-atom false true)
+ (do
+ (logging/trace "invoking one-shot")
+ (jdi/suspend-event-threads event)
+ (let [[out err in test-out report-counters testing-contexts
+ stack-trace-depth] (:bindings options)]
+ (doto
+ (Thread.
+ (fn []
+ (binding [*out* out *err* err *in* in
+ *test-out* test-out
+ *report-counters* report-counters
+ *testing-contexts* testing-contexts
+ *stack-trace-depth* stack-trace-depth]
+ (f event context))))
+ (.start))))
+ (logging/trace "test handler already invoked one-shot"))
+ (do
+ (logging/trace "test handler invoking")
+ (f event context)))
+ (logging/trace "No debug handler for %s" event)))
+ (catch java.lang.Exception e
+ (logging/trace "test handler %s" e))))
View
0 ...st/clojure/swank_clj/jpda/jdi_vm_test.clj → src/test/clojure/ritz/jpda/jdi_vm_test.clj
File renamed without changes.
View
0 src/test/clojure/swank_clj/proxy_test.clj → src/test/clojure/ritz/proxy_test.clj
File renamed without changes.
View
0 ...ure/swank_clj/repl_utils/arglist_test.clj → .../clojure/ritz/repl_utils/arglist_test.clj
File renamed without changes.
View
0 ...wank_clj/repl_utils/class_browse_test.clj → ...ure/ritz/repl_utils/class_browse_test.clj
File renamed without changes.
View
0 .../swank_clj/repl_utils/completion_test.clj → ...ojure/ritz/repl_utils/completion_test.clj
File renamed without changes.
View
0 ...clojure/swank_clj/repl_utils/doc_test.clj → ...test/clojure/ritz/repl_utils/doc_test.clj
File renamed without changes.
View
0 ...lojure/swank_clj/repl_utils/find_test.clj → ...est/clojure/ritz/repl_utils/find_test.clj
File renamed without changes.
View
0 ...jure/swank_clj/repl_utils/format_test.clj → ...t/clojure/ritz/repl_utils/format_test.clj
File renamed without changes.
View
0 ..._clj/repl_utils/fuzzy_completion_test.clj → ...ritz/repl_utils/fuzzy_completion_test.clj
File renamed without changes.
View
0 ...jure/swank_clj/repl_utils/mangle_test.clj → ...t/clojure/ritz/repl_utils/mangle_test.clj
File renamed without changes.
View
0 ...ojure/swank_clj/repl_utils/trace_test.clj → ...st/clojure/ritz/repl_utils/trace_test.clj
File renamed without changes.
View
0 ...est/clojure/swank_clj/rpc_server_test.clj → src/test/clojure/ritz/rpc_server_test.clj
File renamed without changes.
View
0 src/test/clojure/swank_clj/rpc_test.clj → src/test/clojure/ritz/rpc_test.clj
File renamed without changes.
View
0 ...est/clojure/swank_clj/swank/core_test.clj → src/test/clojure/ritz/swank/core_test.clj
File renamed without changes.
View
0 ...t/clojure/swank_clj/swank/indent_test.clj → src/test/clojure/ritz/swank/indent_test.clj
File renamed without changes.
View
0 ...st/clojure/swank_clj/swank/utils_test.clj → src/test/clojure/ritz/swank/utils_test.clj
File renamed without changes.
View
0 src/test/clojure/swank_clj/swank_test.clj → src/test/clojure/ritz/swank_test.clj
File renamed without changes.
View
0 src/test/clojure/swank_clj/test_utils.clj → src/test/clojure/ritz/test_utils.clj
File renamed without changes.
View
17 update-slime-ritz-package-version.sh
@@ -0,0 +1,17 @@
+#!/bin/bash
+
+## Build an elpa package for slime-ritz.el
+## Sets the version number based on the version in package.el
+
+VERSION=$(head -1 project.clj | egrep -o -E "[0-9][0-9a-zA-Z.-]+")
+echo "slime-ritz version $VERSION"
+
+dest="slime-ritz-$VERSION"
+
+sed -i .bak \
+ -e "s/Version: .*/Version: $VERSION/" \
+ src/main/elisp/slime-ritz.el \
+&& rm src/main/elisp/slime-ritz.el.bak \
+&& echo "src/main/elisp/slime-ritz.el ready for upload to marmalade if required"
+
+

0 comments on commit baac7db

Please sign in to comment.