Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge branch 'release/0.2.0'

  • Loading branch information...
commit 869bfe9ac634f4de53f364ce5ee3fc5e217265b8 2 parents 81946cc + 739d015
@hugoduncan hugoduncan authored
View
8 DEVELOPMENT.md
@@ -0,0 +1,8 @@
+# Ritz Development
+
+## vm's
+
+Setup service names in ~/.pallet/config.clj or ~/.pallet/services/xxx.clj
+
+### ubuntu openjdk
+lein pallet -P service-name converge ritz.vms/ritz-dev-ubuntu 1
View
31 README.md
@@ -11,7 +11,7 @@ This is alpha quality.
## Features
-- Break on uncaught exceptions and breakpoints.
+- Break on exceptions and breakpoints.
- Allows stepping from breakpoints
- Allows evaluation of expressions in the context of a stack frame
- Inspection of locals in any stack frame
@@ -34,22 +34,24 @@ this package to use
### Lein/Cake Project
-Add `[ritz "0.1.7"]` to your project.clj `:dev-dependencies`.
+Add `[ritz "0.2.0"]` to your project.clj `:dev-dependencies`.
### Lein Plugin
-Run `lein plugin install ritz 0.1.7`.
+Run `lein plugin install ritz 0.2.0`.
### Maven Plugin
See [zi](https://github.com/pallet/zi).
-### Sun/Oracle JDK
+### Sun/Oracle JDK and OpenJDK
-To use the Sun/Oracle JDK, you
+To use the Sun/Oracle JDK, and possibly OpenJDK, you
[need to add](http://download.oracle.com/javase/1.5.0/docs/tooldocs/findingclasses.html)
-`tools.jar` from your JDK install to your classpath. If you are using maven then
-there are
+`tools.jar` from your JDK install to your classpath. This is not required on OS
+X, where `tools.jar` does not exist.
+
+If you are using maven then there are
[instructions in the FAQ](http://maven.apache.org/general.html#tools-jar-dependency).
For cake, add the following (with the correct jdk path), to
@@ -60,6 +62,8 @@ For lein, add the tools.jar to the dev-resources-path:
:dev-resources-path "/usr/lib/jvm/java-6-sun/lib/tools.jar"
+If you are missing tools.jar from the classpath, you will see an exception like `java.lang.ClassNotFoundException: com.sun.jdi.VirtualMachine`.
+
### Source Browsing
If you would like to browse into the clojure java sources then add the following
@@ -106,6 +110,19 @@ To list breakpoints, use `M-x slime-list-breakpoints` or press `b` in the
- k remove breakpoint
- v view source location
+### Exception filtering
+
+To filter which exceptions break into the debugger, there is an `IGNORE`
+restart, that will ignore an exception type.
+
+To list breakpoints, use `M-x slime-list-exception-filters` or press `f` in the
+`slime-selector`. In the listing you can use the following keys
+
+ - e enable
+ - d disable
+ - g refresh list
+ - k remove exception filter
+
### Javadoc
Specify the location of local javadoc using `slime-javadoc-local-paths` in
View
43 ReleaseNotes.md
@@ -1,6 +1,47 @@
# Release Notes
-Current release is 0.1.7.
+Current release is 0.1.8.
+
+* 0.1.8
+
+- Update readme with section on exception filtering
+
+- Remove java reflection in logging code
+
+- Add exception filters
+ The filters can be set by the IGNORE restart, and can be edited in the
+ slime selector using the 'f key.
+
+- Log issue with inability to send command to connection
+ This occurs on init script processing (not fixed yet)
+
+- Update to recent pallet versions
+
+- Add stone excepetion display
+
+- Put all clojure source dependencies into lein-multi config
+
+- Display pprint of Stone or Condition exceptions
+
+- Update readme to explicitly state the OS X doesn't have tools.jar
+
+- Use clojure.main/with-bindings and flush output
+
+- Factor out repl-utils/io
+
+- Update logback versions and use :local-repo-classpath
+
+- Changes to break-for-exception? and fix swank-clj references
+
+- Normailse function formatting
+
+- Update readme to mention openjdk in tools.jar setup, and list the exception
+ that is raised if tools.jar is missing
+
+- Add note to readme about tools.jar and maven
+
+- Add pallet script to set up a dev environment for ritz
+ Basic tmux, emacs, git install, with clone of ritz repo
* 0.1.7
View
2  finish-release.sh
@@ -13,7 +13,7 @@ echo "finish release of $version"
echo -n "commiting project.clj, release notes and readme. enter to continue:" \
&& read x \
-&& git add project.clj ReleaseNotes.md README.md \
+&& git add project.clj ReleaseNotes.md README.md src/main/elisp/slime-ritz.el \
&& git commit -m "Updated project.clj, release notes and readme for $version" \
&& echo -n "Peform release. enter to continue:" && read x \
&& lein test \
View
25 project.clj
@@ -1,20 +1,27 @@
-(defproject ritz "0.1.7"
+(defproject ritz "0.2.0"
:description "Another swank server for clojure in SLIME"
:source-path "src/main/clojure"
:resources-path "src/main/resources"
:test-path "src/test/clojure"
:dependencies [[org.clojure/clojure "1.2.1"]
[useful "0.4.0"]]
- :dev-dependencies [[org.clojure/clojure "1.2.1" :classifier "sources"]
- [lein-multi "1.0.0"]]
+ :dev-dependencies [[lein-multi "1.0.0"]
+ [org.cloudhoist/pallet "0.7.0-SNAPSHOT"]
+ [org.cloudhoist/stevedore "0.7.0"]
+ [org.cloudhoist/git "0.7.0-SNAPSHOT"]
+ [org.cloudhoist/java "0.7.0-SNAPSHOT"]
+ [org.cloudhoist/pallet-lein "0.4.2-SNAPSHOT"]
+ [org.slf4j/slf4j-api "1.6.1"]
+ [ch.qos.logback/logback-core "0.9.29"]
+ [ch.qos.logback/logback-classic "0.9.29"]
+ [vmfest "0.2.3"]]
:multi-deps {"1.2.0" [[org.clojure/clojure "1.2.0"]
[clojure-source "1.2.0"]]
- "1.3" [[org.clojure/clojure "1.3.0-master-SNAPSHOT"]
- [org.clojure/clojure "1.3.0-master-SNAPSHOT"
- :classifier "sources"]]
- "1.3.0-alpha8" [[org.clojure/clojure "1.3.0-alpha8"]
- [org.clojure/clojure "1.3.0-alpha8"
- :classifier "sources"]]}
+ "1.2.1" [[org.clojure/clojure "1.2.1"]
+ [org.clojure/clojure "1.2.1" :classifier "sources"]]
+ "1.3" [[org.clojure/clojure "1.3.0"]
+ [org.clojure/clojure "1.3.0" :classifier "sources"]]}
+ :local-repo-classpath true
:repositories
{"sonatype-snapshots" "https://oss.sonatype.org/content/repositories/snapshots"
"sonatype" "https://oss.sonatype.org/content/repositories/releases/"}
View
31 src/main/clojure/ritz/commands/basic.clj
@@ -12,6 +12,7 @@
[ritz.repl-utils.find :as find]
[ritz.repl-utils.format :as format]
[ritz.repl-utils.helpers :as helpers]
+ [ritz.repl-utils.io :as io]
[ritz.repl-utils.sys :as sys]
[ritz.repl-utils.trace :as trace]
[ritz.swank.core :as core]
@@ -176,38 +177,12 @@
(defslimefn load-file [connection file-name]
(pr-str (clojure.core/load-file file-name)))
-(defn- line-at-position [file position]
- (try
- (with-open [f (java.io.LineNumberReader. (java.io.FileReader. file))]
- (.skip f position)
- (.getLineNumber f))
- (catch Exception e 1)))
-
-(defn read-position-line [file position]
- (if (number? position)
- (if (.isFile file)
- (line-at-position file position)
- 0)
- (when (list? position)
- (or
- (second (first (filter #(= :line (first %)) position)))
- (when-let [p (second (first (filter #(= :position (first %)) position)))]
- (line-at-position file p))))))
-
-(defn guess-namespace [file]
- (->>
- (reverse (.split (.getParent file) "/"))
- (reductions #(str %1 "." %2))
- (map symbol)
- (filter find-ns)
- first))
-
(defslimefn compile-string-for-emacs
[connection string buffer position buffer-path debug]
(let [start (System/nanoTime)
file (java.io.File. buffer-path)
- line (read-position-line file position)
- ret (binding [*ns* (or (guess-namespace file) *ns*)]
+ line (io/read-position-line file position)
+ ret (binding [*ns* (or (io/guess-namespace file) *ns*)]
(compile/compile-region string buffer-path line))
delta (- (System/nanoTime) start)]
(messages/compilation-result nil ret (/ delta 1000000000.0))))
View
32 src/main/clojure/ritz/commands/contrib/ritz.clj
@@ -69,6 +69,38 @@ corresponding attribute values per thread."
(debug/breakpoint-location
(connection/vm-context connection) breakpoint-id)))
+;;; Exception Filters
+(defslimefn quit-exception-filter-browser [connection])
+
+(defn ^{:private true} exception-filter-data-fn
+ [i {:keys [type location catch-location enabled]}]
+ (list i type location catch-location enabled))
+
+(defslimefn list-exception-filters [connection]
+ "Return a list
+ (LABELS (ID TYPE LOCATION CATCH-LOCATION ENABLED ATTRS ...) ...).
+LABELS is a list of attribute names and the remaining lists are the
+corresponding attribute values per thread."
+ [connection]
+ (let [filters (debug/exception-filter-list @connection)
+ labels '(:id :type :location :catch-location :enabled)]
+ (cons labels (map exception-filter-data-fn (range) filters))))
+
+(defslimefn exception-filter-kill
+ [connection exception-filter-id]
+ (debug/exception-filter-kill connection exception-filter-id)
+ nil)
+
+(defslimefn exception-filter-enable
+ [connection exception-filter-id]
+ (debug/exception-filter-enable connection exception-filter-id)
+ nil)
+
+(defslimefn exception-filter-disable
+ [connection exception-filter-id]
+ (debug/exception-filter-disable connection exception-filter-id)
+ nil)
+
;;; javadoc
(defslimefn javadoc-local-paths
[connection & paths]
View
27 src/main/clojure/ritz/connection.clj
@@ -34,7 +34,9 @@
(defn send-to-emacs
"Sends a message (msg) to emacs."
[connection msg]
- (send-to-emacs* @connection msg))
+ (if connection
+ (send-to-emacs* @connection msg)
+ (logging/trace "Unable to send message to nil connection %s" msg)))
(defn read-from-connection
"Read a form from the connection."
@@ -129,15 +131,24 @@
:result-history nil
:last-exception nil
:indent-cache-hash (atom nil)
- :indent-cache (ref {})})))]
+ :indent-cache (ref {})
+ :exception-filters
+ [{:type "clojure.lang.LockingTransaction$RetryEx"
+ :enabled true}
+ {:type "com.google.inject.internal.ErrorsException"
+ :enabled true}
+ {:catch-location #"com.sun.*" :enabled true}
+ {:catch-location #"sun.*" :enabled true}
+ {:catch-location #"ritz.commands.*"
+ :enabled true}]})))]
;;(when-not (:proxy-to options))
- (swap! connection
- (fn [connection]
- (merge connection
- (zipmap
- [:input-redir :input-source :input-tag]
- (make-repl-input-stream connection)))))
+ (swap! connection
+ (fn [connection]
+ (merge connection
+ (zipmap
+ [:input-redir :input-source :input-tag]
+ (make-repl-input-stream connection)))))
;; (logging/trace "connection %s" (pr-str @connection))
connection))
View
238 src/main/clojure/ritz/jpda/debug.clj
@@ -138,6 +138,7 @@
(if-let [port (jdi-clj/control-eval
context
;; NB very important that this doesn't throw
+ ;; as that can cause hangs in the startup
`(when (find-ns '~'ritz.socket-server)
(when-let [v# (resolve
'~'ritz.socket-server/acceptor-port)]
@@ -399,6 +400,44 @@
(jdi/location-source-path location))]
[path {:line (jdi/location-line-number location)}]))))
+;;; exception-filters
+(defn exception-filter-list
+ "Return a sequence of exception filters, ensuring that expressions are strings
+ and not regexes."
+ [connection]
+ (map
+ (fn [filter]
+ (->
+ filter
+ (update-in [:location] str)
+ (update-in [:catch-location] str)))
+ (:exception-filters connection)))
+
+(defn exception-filter-kill
+ "Remove an exception-filter."
+ [connection id]
+ (swap! connection update-in [:exception-filters]
+ #(vec (concat
+ (take (max id 0) %)
+ (drop (inc id) %)))))
+
+(defn update-filter-exception
+ [connection id f]
+ (swap! connection update-in [:exception-filters]
+ #(vec (concat
+ (take id %)
+ [(f (nth % id))]
+ (drop (inc id) %)))))
+
+(defn exception-filter-enable
+ [connection id]
+ (update-filter-exception connection id #(assoc % :enabled true)))
+
+(defn exception-filter-disable
+ [connection id]
+ (update-filter-exception connection id #(assoc % :enabled false)))
+
+
;;; debug methods
;; This is a synthetic Event for an InvocationException delivered to the debug
@@ -527,6 +566,13 @@
(jdi/suspend-policy breakpoint-suspend-policy)
(.enable)))
+(defn ignore-exception-type
+ "Add the specified exception to the connection's never-break-exceptions set."
+ [connection exception-type]
+ (logging/trace "Adding %s to never-break-exceptions" exception-type)
+ (swap! connection update-in [:exception-filters] conj
+ {:type exception-type :enabled true}))
+
(defn make-restart
"Make a restart map.
Contains
@@ -573,8 +619,55 @@
(jdi-clj/eval
context thread jdi/invoke-single-threaded
`(do
+ (require 'clojure.pprint)
(defn ~(symbol s) [c#]
- (str (dissoc @(.state c#) :stack-trace :message)))))
+ (let [f# (fn ~'classify-exception-fn [e#]
+ (case (.getName (class e#))
+ "clojure.contrib.condition.Condition" :condition
+ "slingshot.Stone" :stone
+ "clojure.lang.PersistentHashMap" :stone-context
+ "clojure.lang.PersistentArrayMap" :stone-context
+ :throwable))
+ gc# (fn ~'get-cause-fn [e#]
+ (case (f# e#)
+ :stone (:obj (.context e#))
+ :stone-context (:next e#)
+ (.getCause e#)))
+ pc# (fn ~'print-cause-fn [e#]
+ (case (f# e#)
+ :condition [(:message e#)
+ (first (:stack-trace e#))]
+ :throwable [(.getMessage e#)
+ (first (.getStackTrace e#))]
+ :stone [(dissoc (.context e#) :stack :next)
+ (first (:stack (.context e#)))]
+ :stone-context [(dissoc e# :stack :next)
+ (first (:stack e#))]))
+ ca# (fn ~'cause-chain-fn [e#]
+ (vec
+ (map
+ pc#
+ (take-while identity (iterate gc# e#)))))]
+ (case (f# c#)
+ :condition
+ (with-out-str
+ (println (:message @(.state c#)))
+ (clojure.pprint/pprint
+ [(dissoc @(.state c#) :message)
+ (ca# c#)]))
+ :stone
+ (do
+ (with-out-str
+ (println (.messagePrefix c#))
+ (clojure.pprint/pprint
+ (.object c#))
+ (clojure.pprint/pprint
+ (.context c#))))
+ :throwable
+ (with-out-str
+ (clojure.pprint/pprint
+ [(.getMessage c#)
+ (ca# c#)])))))))
(logging/trace "defined condition-printer-fn")
(reset!
remote-condition-printer-fn
@@ -600,16 +693,15 @@
(let [exception (.exception event)
exception-type (.. exception referenceType name)
thread (jdi/event-thread event)]
- {:message (str
- (or (jdi-clj/exception-message context event) "No message.")
- (if (= exception-type "clojure.contrib.condition.Condition")
- (let [[object method] (remote-condition-printer
- context thread)]
- (str "\n" (jdi/invoke-method
- thread
- jdi/invoke-multi-threaded
- object method [exception])))
- ""))
+ {:message (if (#{"clojure.contrib.condition.Condition"
+ "slingshot.Stone"} exception-type)
+ (let [[object method] (remote-condition-printer
+ context thread)]
+ (str "\n" (jdi/invoke-method
+ thread
+ jdi/invoke-multi-threaded
+ object method [exception])))
+ (or (jdi-clj/exception-message context event) "No message."))
:type (str " [Thrown " exception-type "]")}))
(restarts
@@ -634,7 +726,16 @@
:quit "QUIT" "Return to previous level."
(fn [connection]
(logging/trace "restart Quiting to previous level")
- (quit-level connection))))])
+ (quit-level connection))))
+ (make-restart
+ :abort "IGNORE" "Do not enter debugger for this exception type"
+ (fn [connection]
+ (logging/trace "restart Ignoring exceptions")
+ (ignore-exception-type
+ connection (.. exception exception referenceType name))
+ (continue-level connection)))])
+ ;; Never break on this exception at this catch location
+ ;; Never break on this exception at this throw location
(filter
identity
[(when (pos? (connection/sldb-level connection))
@@ -1002,74 +1103,44 @@
(.enable)))
;;; VM events
-(defn caught?
- "Predicate for testing if the given exception is caught outside of ritz"
- [exception-event]
- (when-let [catch-location (jdi/catch-location exception-event)]
- (let [catch-location-name (jdi/location-type-name catch-location)
- location (jdi/location exception-event)
- location-name (jdi/location-type-name location)]
- (logging/trace "caught? %s %s" catch-location-name location-name)
- (or (not (.startsWith catch-location-name "swank_clj.swank"))
- (and
- (not (re-matches #"[^$]+\$eval.*." location-name))
- (.startsWith catch-location-name "clojure.lang.Compiler"))))))
-
-(defn ignore-location?
- "Predicate for testing if the given thread is inside of ritz"
- [thread]
- (when-let [frame (first (.frames thread))]
- (when-let [location (.location frame)]
- (let [location-name (jdi/location-type-name location)]
- (logging/trace "ignore-location? %s" location-name)
- (or (.startsWith location-name "swank_clj.swank")
- (.startsWith location-name "swank_clj.commands.contrib")
- (.startsWith location-name "clojure.lang.Compiler"))))))
-
-(defn stacktrace-contains?
- "Predicate to check for specific deifining type name in the stack trace."
- [thread defining-type]
- (some
- #(= defining-type (jdi/location-type-name (.location %)))
- (.frames thread)))
+
+;; macros like `binding`, that use (try ... (finally ...)) cause exceptions
+;; within their bodies to be considered caught. We therefore need some
+;; way for the user to be able to maintain a list of catch locations that
+;; should not be considered as "caught".
+
+(defn break-for?
+ [connection exception-type location-name catch-location-name]
+ (letfn [(equal-or-matches? [expr value]
+ (logging/trace "checking equal-or-matches? %s %s" expr value)
+ (cond
+ (string? expr) (= expr value)
+ :else (re-matches expr value)))
+ (matches? [{:keys [type location catch-location enabled] :as filter}]
+ (and
+ enabled
+ (or (not type) (= type exception-type))
+ (or (not location)
+ (equal-or-matches? location location-name))
+ (or (not catch-location)
+ (equal-or-matches? catch-location catch-location-name))))]
+ (not (some matches? (:exception-filters @connection)))))
(defn break-for-exception?
- "Predicate to check whether we should invoke the debugger fo the given
+ "Predicate to check whether we should invoke the debugger for the given
exception event"
- [exception-event]
+ [exception-event connection]
(let [catch-location (jdi/catch-location exception-event)
location (jdi/location exception-event)
- location-name (jdi/location-type-name location)]
- (or
- (not catch-location)
- (let [catch-location-name (jdi/location-type-name catch-location)]
- (logging/trace
+ location-name (jdi/location-type-name location)
+ exception (.exception exception-event)
+ exception-type (.. exception referenceType name)
+ catch-location-name (jdi/location-type-name catch-location)]
+ (logging/trace
"break-for-exception? %s %s" catch-location-name location-name)
- (or
- (.startsWith catch-location-name "swank_clj.swank")
- (and
- (.startsWith catch-location-name "clojure.lang.Compiler")
- (stacktrace-contains?
- (jdi/event-thread exception-event)
- "swank_clj.commands.basic$eval_region")))
- ;; (or
- ;; ;; (and
- ;; ;; (.startsWith location-name "clojure.lang.Compiler")
- ;; ;; (re-matches #"[^$]+\$eval.*." catch-location-name))
- ;; ;; (and
- ;; ;; (.startsWith catch-location-name "clojure.lang.Compiler")
- ;; ;; (re-matches #"[^$]+\$eval.*." location-name))
- ;; (.startsWith catch-location-name "swank_clj.swank"))
- ;; (or
- ;; (and
- ;; (.startsWith location-name "clojure.lang.Compiler")
- ;; (re-matches #"[^$]+\$eval.*." catch-location-name))
- ;; (and
- ;; (.startsWith catch-location-name "clojure.lang.Compiler")
- ;; (re-matches #"[^$]+\$eval.*." location-name))
- ;; (not (.startsWith catch-location-name "swank_clj.swank")))
- ))))
-
+ (or (not catch-location)
+ (break-for?
+ connection exception-type location-name catch-location-name))))
(defn connection-and-id-from-thread
"Walk the stack frames to find the eval-for-emacs call and extract
@@ -1079,7 +1150,7 @@
(logging/trace "connection-and-id-from-thread %s" thread)
(some (fn [frame]
(when-let [location (.location frame)]
- (when (and (= "swank_clj.swank$eval_for_emacs"
+ (when (and (= "ritz.swank$eval_for_emacs"
(jdi/location-type-name location))
(= "invoke" (jdi/location-method-name location)))
;; (logging/trace "connection-and-id-from-thread found frame")
@@ -1108,16 +1179,13 @@
(logging/trace "EXCEPTION %s" exception)
;; would like to print this, but can cause hangs
;; (jdi-clj/exception-message context event)
- (if (break-for-exception? event)
- (if-let [connection (ffirst @connections)]
- (if (aborting-level? connection)
- (logging/trace "Not activating sldb (aborting)")
- (do
- (logging/trace "Activating sldb")
- ;; invoke the debugger to show the stack trace and restarts
- (invoke-debugger connection event)))
- (logging/trace "Not activating sldb (no connection)"))
- ;; (logging/trace "Not activating sldb (break-for-exception?)")
+ (if-let [connection (ffirst @connections)]
+ (if (aborting-level? connection)
+ (logging/trace "Not activating sldb (aborting)")
+ (when (break-for-exception? event connection)
+ (logging/trace "Activating sldb")
+ (invoke-debugger connection event)))
+ ;; (logging/trace "Not activating sldb (no connection)")
))
(if silent?
(logging/trace-str "@")
View
2  src/main/clojure/ritz/jpda/jdi.clj
@@ -527,7 +527,7 @@ Thread
(defn threads
[vm]
- (.allThreads vm))
+ (when vm (.allThreads vm)))
(def thread-states
{ThreadReference/THREAD_STATUS_MONITOR :monitor
View
5 src/main/clojure/ritz/logging.clj
@@ -1,8 +1,9 @@
(ns ritz.logging
"Logging for swank. Rudimentary for now")
-(defonce logging-out (or *out* (java.io.FileWriter.
- (java.io.File. "/tmp/swank.log"))))
+(defonce ^java.io.Writer logging-out
+ (or *out* (java.io.FileWriter. (java.io.File. "/tmp/swank.log"))))
+
(def monitor (Object.))
(def log-level (atom nil))
View
4 src/main/clojure/ritz/proxy.clj
@@ -4,8 +4,12 @@
[clojure.pprint :as pprint]
[ritz.executor :as executor]
[ritz.hooks :as hooks]
+ [ritz.repl-utils.io :as io]
+ [ritz.repl-utils.compile :as compile]
[ritz.swank :as swank]
+ [ritz.swank.commands :as commands]
[ritz.swank.core :as core]
+ [ritz.swank.messages :as messages]
[ritz.rpc-server :as rpc-server]
[ritz.logging :as logging]
[ritz.jpda.debug :as debug]
View
28 src/main/clojure/ritz/repl_utils/io.clj
@@ -0,0 +1,28 @@
+(ns ritz.repl-utils.io
+ "io for reading clojure files")
+
+(defn guess-namespace [^java.io.File file]
+ (->>
+ (reverse (.split (.getParent file) "/"))
+ (reductions #(str %1 "." %2))
+ (map symbol)
+ (filter find-ns)
+ first))
+
+(defn- line-at-position [^java.io.File file position]
+ (try
+ (with-open [f (java.io.LineNumberReader. (java.io.FileReader. file))]
+ (.skip f position)
+ (.getLineNumber f))
+ (catch Exception e 1)))
+
+(defn read-position-line [file position]
+ (if (number? position)
+ (if (.isFile file)
+ (line-at-position file position)
+ 0)
+ (when (list? position)
+ (or
+ (second (first (filter #(= :line (first %)) position)))
+ (when-let [p (second (first (filter #(= :position (first %)) position)))]
+ (line-at-position file p))))))
View
160 src/main/clojure/ritz/rpc.clj
@@ -2,7 +2,8 @@
"Pass remote calls and responses between lisp systems using the swank-rpc
protocol. Code from Terje Norderhaug <terje@in-progress.com>."
(:require
- [ritz.logging :as logging])
+ [ritz.logging :as logging]
+ [clojure.string :as string])
(:import
(java.io Writer Reader PushbackReader StringReader)))
@@ -23,75 +24,75 @@ protocol. Code from Terje Norderhaug <terje@in-progress.com>."
(str sb))))
(defn- read-form
- "Read a form that conforms to the swank rpc protocol"
- ([^Reader rdr]
- (let [c (.read rdr)]
- (condp = (char c)
- \" (let [sb (StringBuilder.)]
- (loop []
- (let [c (.read rdr)]
- (if (= c -1)
- (throw
- (java.io.EOFException.
- "Incomplete reading of quoted string."))
- (condp = (char c)
- \" (str sb)
- \\ (do (.append sb (char (.read rdr)))
- (recur))
- (do (.append sb (char c))
- (recur)))))))
- \( (loop [result []]
- (let [form (read-form rdr)]
- (let [c (.read rdr)]
- (if (= c -1)
- (throw
- (java.io.EOFException.
- "Incomplete reading of list."))
- (condp = (char c)
- \) (sequence (conj result form))
- \space (recur (conj result form)))))))
- \' (list 'quote (read-form rdr))
- (let [sb (StringBuilder.)]
- (loop [c c]
- (if (not= c -1)
- (condp = (char c)
- \\ (do (.append sb (char (.read rdr)))
- (recur (.read rdr)))
- \space (.unread rdr c)
- \) (.unread rdr c)
- (do (.append sb (char c))
- (recur (.read rdr))))))
- (let [str (str sb)]
- (cond
- (Character/isDigit c) (read-string str)
- (= "nil" str) nil
- (= "t" str) true
- (.startsWith str ":") (keyword (.substring str 1))
- :else
- (if-let [m (re-matches #"(.+):(.+)" str)]
- (if (= "swank::%cursor-marker%" str)
- :ritz/cursor-marker
- (apply symbol (rest m)))
- (symbol str)))))))))
+ "Read a form that conforms to the swank rpc protocol"
+ [^Reader rdr]
+ (let [c (.read rdr)]
+ (condp = (char c)
+ \" (let [sb (StringBuilder.)]
+ (loop []
+ (let [c (.read rdr)]
+ (if (= c -1)
+ (throw
+ (java.io.EOFException.
+ "Incomplete reading of quoted string."))
+ (condp = (char c)
+ \" (str sb)
+ \\ (do (.append sb (char (.read rdr)))
+ (recur))
+ (do (.append sb (char c))
+ (recur)))))))
+ \( (loop [result []]
+ (let [form (read-form rdr)]
+ (let [c (.read rdr)]
+ (if (= c -1)
+ (throw
+ (java.io.EOFException.
+ "Incomplete reading of list."))
+ (condp = (char c)
+ \) (sequence (conj result form))
+ \space (recur (conj result form)))))))
+ \' (list 'quote (read-form rdr))
+ (let [sb (StringBuilder.)]
+ (loop [c c]
+ (if (not= c -1)
+ (condp = (char c)
+ \\ (do (.append sb (char (.read rdr)))
+ (recur (.read rdr)))
+ \space (.unread rdr c)
+ \) (.unread rdr c)
+ (do (.append sb (char c))
+ (recur (.read rdr))))))
+ (let [str (str sb)]
+ (cond
+ (Character/isDigit c) (read-string str)
+ (= "nil" str) nil
+ (= "t" str) true
+ (.startsWith str ":") (keyword (.substring str 1))
+ :else
+ (if-let [m (re-matches #"(.+):(.+)" str)]
+ (if (= "swank::%cursor-marker%" str)
+ :ritz/cursor-marker
+ (apply symbol (map #(string/replace % "\\." ".") (rest m))))
+ (symbol str))))))))
(defn- read-packet
- ([^Reader reader]
- (let [len (read-chars reader 6 swank-protocol-error)
- _ (logging/trace "rpc/read-packet length %s" len)
- len (Integer/parseInt len 16)]
- (logging/trace "rpc/read-packet length %s" len)
- (read-chars reader len swank-protocol-error))))
+ [^Reader reader]
+ (let [len (read-chars reader 6 swank-protocol-error)
+ _ (logging/trace "rpc/read-packet length %s" len)
+ len (Integer/parseInt len 16)]
+ (logging/trace "rpc/read-packet length %s" len)
+ (read-chars reader len swank-protocol-error)))
(defn decode-message
- "Read an rpc message encoded using the swank rpc protocol."
- ([^Reader rdr]
- (let [packet (read-packet rdr)]
- (logging/trace "READ: %s\n" packet)
- (try
- (with-open [rdr (PushbackReader. (StringReader. packet))]
- (read-form rdr))
- (catch Exception e
- (list :reader-error packet e))))))
+ "Read an rpc message encoded using the swank rpc protocol."
+ [^Reader rdr]
+ (let [packet (read-packet rdr)]
+ (logging/trace "READ: %s\n" packet)
+ (try
+ (with-open [rdr (PushbackReader. (StringReader. packet))]
+ (read-form rdr))
+ (catch Exception e
+ (list :reader-error packet e)))))
;; OUTPUT
@@ -114,7 +115,8 @@ protocol. Code from Terje Norderhaug <terje@in-progress.com>."
(.append w \"))
nil))
-(defmethod print-object clojure.lang.ISeq [o, ^Writer w]
+(defmethod print-object clojure.lang.ISeq
+ [o, ^Writer w]
(.write w "(")
(print-object (first o) w)
(doseq [item (rest o)]
@@ -123,21 +125,21 @@ protocol. Code from Terje Norderhaug <terje@in-progress.com>."
(.write w ")"))
(defn- write-form
- ([^Writer writer message]
- (print-object message writer)))
+ [^Writer writer message]
+ (print-object message writer))
(defn- write-packet
- ([^Writer writer str]
- (let [len (.length str)]
+ [^Writer writer str]
+ (let [len (.length str)]
(doto writer
- (.write (format "%06x" len))
- (.write str)
- (.flush)))))
+ (.write (format "%06x" len))
+ (.write str)
+ (.flush))))
(defn encode-message
"Write an rpc message encoded using the swank rpc protocol."
- ([^Writer writer message]
- (let [str (with-out-str
- (write-form *out* message)) ]
- (logging/trace "WRITE: %s\n" str)
- (write-packet writer str))))
+ [^Writer writer message]
+ (let [str (with-out-str
+ (write-form *out* message)) ]
+ (logging/trace "WRITE: %s\n" str)
+ (write-packet writer str)))
View
19 src/main/clojure/ritz/swank.clj
@@ -95,13 +95,18 @@
"swank/dispatch-event: :emacs-rex %s %s %s %s"
form-string package thread id)
(let [last-values (:result-history @connection)]
- (binding [*1 (first last-values)
- *2 (fnext last-values)
- *3 (first (nnext last-values))
- *e (:last-exception @connection)
- *out* (:writer-redir @connection)
- *in* (:input-redir @connection)]
- (eval-for-emacs connection form-string package id))))
+ (try
+ (clojure.main/with-bindings
+ (binding [*1 (first last-values)
+ *2 (fnext last-values)
+ *3 (first (nnext last-values))
+ *e (:last-exception @connection)
+ *out* (:writer-redir @connection)
+ *in* (:input-redir @connection)]
+ (try
+ (eval-for-emacs connection form-string package id)
+ (finally (flush)))))
+ (finally (flush)))))
:emacs-return-string
(let [[thread tag value] args]
View
126 src/main/elisp/slime-ritz.el
@@ -5,7 +5,7 @@
;; Author: Hugo Duncan <hugo_duncan@yahoo.com>
;; Keywords: languages, lisp, slime
;; URL: https://github.com/pallet/ritz
-;; Version: 0.1.6
+;; Version: 0.2.0
;; License: EPL
(define-slime-contrib slime-ritz
@@ -171,6 +171,130 @@
(slime-list-breakpoints)
slime-breakpoints-buffer-name)
+;;;;; Exception Filters
+(defvar slime-exception-filters-buffer-name (slime-buffer-name :exception-filters))
+
+(defun slime-list-exception-filters ()
+ "Display a list of exception filterss."
+ (interactive)
+ (let ((name slime-exception-filters-buffer-name))
+ (slime-with-popup-buffer (name :connection t
+ :mode 'slime-exception-filter-control-mode)
+ (slime-update-exception-filters-buffer)
+ (goto-char (point-min))
+ (setq slime-popup-buffer-quit-function 'slime-quit-exception-filters-buffer))))
+
+(defvar slime-exception-filter-index-to-id nil)
+
+(defun slime-quit-exception-filters-buffer (&optional _)
+ (slime-popup-buffer-quit t)
+ (setq slime-exception-filter-index-to-id nil)
+ (slime-eval-async `(swank:quit-exception-filter-browser)))
+
+(defun slime-update-exception-filters-buffer ()
+ (interactive)
+ (with-current-buffer slime-exception-filters-buffer-name
+ (slime-eval-async '(swank:list-exception-filters)
+ 'slime-display-exception-filters)))
+
+(defun slime-display-exception-filters (filters)
+ (with-current-buffer slime-exception-filters-buffer-name
+ (let* ((inhibit-read-only t)
+ (index (get-text-property (point) 'exception-filter-id))
+ (old-exception-filter-id (and (numberp index)
+ (elt slime-exception-filter-index-to-id index)))
+ (old-line (line-number-at-pos))
+ (old-column (current-column)))
+ (setq slime-exception-filter-index-to-id (mapcar 'car (cdr filters)))
+ (erase-buffer)
+ (slime-insert-exception-filters filters)
+ (let ((new-position (position old-exception-filter-id filters :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-exception-filters-table-properties*
+ '(nil (face bold)))
+
+(defun slime-format-exception-filters-labels (exceptions)
+ (let ((labels (mapcar (lambda (x)
+ (capitalize (substring (symbol-name x) 1)))
+ (car exceptions))))
+ (cons labels (cdr exceptions))))
+
+(defun slime-insert-exception-filter (exception-filter longest-lines)
+ (unless (bolp) (insert "\n"))
+ (loop for i from 0
+ for align in longest-lines
+ for element in exception-filter
+ for string = (prin1-to-string element t)
+ for property = (nth i *slime-exception-filters-table-properties*)
+ do
+ (if property
+ (slime-insert-propertized property string)
+ (insert string))
+ (insert-char ?\ (- align (length string) -3))))
+
+(defun slime-insert-exception-filters (exception-filters)
+ (let* ((exception-filters (slime-format-exception-filters-labels exception-filters))
+ (longest-lines (slime-longest-lines exception-filters))
+ (labels (let (*slime-exception-filters-table-properties*)
+ (with-temp-buffer
+ (slime-insert-exception-filter (car exception-filters) 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 exception-filter in (cdr exception-filters)
+ do
+ (slime-propertize-region `(exception-filter-id ,index)
+ (slime-insert-exception-filter exception-filter longest-lines)))))
+
+;;;;; Major mode
+
+(define-derived-mode slime-exception-filter-control-mode fundamental-mode
+ "ExceptionFilters"
+ "SLIME Exception Filter Control Panel Mode.
+
+\\{slime-exception-filter-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-exception-filter-control-mode-map
+ ("d" 'slime-exception-filter-disable)
+ ("e" 'slime-exception-filter-enable)
+ ("g" 'slime-update-exception-filters-buffer)
+ ("k" 'slime-exception-filter-kill))
+
+(defun slime-exception-filter-kill ()
+ (interactive)
+ (slime-eval `(swank:exception-filter-kill
+ ,@(slime-get-properties 'exception-filter-id)))
+ (call-interactively 'slime-update-exception-filters-buffer))
+
+(defun slime-exception-filter-disable ()
+ (interactive)
+ (let ((id (get-text-property (point) 'exception-filter-id)))
+ (slime-eval-async `(swank:exception-filter-disable ,id)))
+ (call-interactively 'slime-update-exception-filters-buffer))
+
+(defun slime-exception-filter-enable ()
+ (interactive)
+ (let ((id (get-text-property (point) 'exception-filter-id)))
+ (slime-eval-async `(swank:exception-filter-enable ,id)))
+ (call-interactively 'slime-update-exception-filters-buffer))
+
+(def-slime-selector-method ?f
+ "SLIME Filter exceptions buffer"
+ (slime-list-exception-filters)
+ slime-exception-filters-buffer-name)
+
;;; repl forms
(defun slime-list-repl-forms ()
"List the source forms"
View
1  src/test/clojure/ritz/connection_test.clj
@@ -23,6 +23,7 @@
(is (:writer-redir @c))
(is (set? (:pending @c)))
(is (map? @(:inspector @c)))
+ (is (vector? (:exception-filters @c)))
(finally
(when-not (.isClosed s) (.close s))
(when-not (.isClosed a) (.close a))))))
View
65 src/test/clojure/ritz/vms.clj
@@ -0,0 +1,65 @@
+(ns ritz.vms
+ "VMs for running ritz"
+ (:require
+ [pallet.core :as core]
+ [pallet.crate.automated-admin-user :as automated-admin-user]
+ [pallet.crate.git :as git]
+ [pallet.crate.java :as java]
+ [pallet.action.directory :as directory]
+ [pallet.action.exec-script :as exec-script]
+ [pallet.action.package :as package]
+ [pallet.action.remote-file :as remote-file]
+ [pallet.phase :as phase]
+ [pallet.script.lib :as lib]
+ [pallet.session :as session]))
+
+
+(def base-spec
+ (core/server-spec
+ :phases {:bootstrap automated-admin-user/automated-admin-user}))
+
+(defn lein
+ "Install latest stable lein"
+ [session]
+ (let [admin-user (session/admin-user session)]
+ (->
+ session
+ (directory/directory
+ "bin" :owner (:username admin-user) :mode "755")
+ (remote-file/remote-file
+ "bin/lein"
+ :owner (:username admin-user) :mode "755"
+ :url "https://github.com/technomancy/leiningen/raw/stable/bin/lein"
+ :no-versioning true)
+ (exec-script/exec-checked-script
+ "Upgrade lein"
+ (sudo -u ~(:username admin-user)
+ (~lib/heredoc-in ("bin/lein" upgrade) "Y\n" {}))))))
+
+(def clojure-dev
+ (core/server-spec
+ :phases {:configure (phase/phase-fn
+ (git/git)
+ (java/java :openjdk :jdk)
+ (package/package "tmux")
+ (package/package "emacs")
+ (lein))}))
+
+(def ritz-dev
+ (core/server-spec
+ :phases {:configure
+ (fn [session]
+ (->
+ session
+ (exec-script/exec-checked-script
+ "Clone ritz"
+ (if-not (directory? rtiz)
+ (sudo -u ~(:username (session/admin-user session))
+ git clone "git://github.com/pallet/ritz")))))}))
+
+(def ritz-dev-ubuntu
+ (core/group-spec
+ "ritz"
+ :extends [base-spec clojure-dev ritz-dev]
+ :node-spec (core/node-spec
+ :image {:os-family :ubuntu :os-version-matches "10.10"})))
Please sign in to comment.
Something went wrong with that request. Please try again.