Permalink
Browse files

Finished scroll impl for list, table, and text widgets.

  • Loading branch information...
1 parent 283c168 commit e2e0c989157592e89d956bd79076fd1bfff690f8 @daveray committed Jul 24, 2011
Showing with 260 additions and 70 deletions.
  1. +61 −3 src/seesaw/core.clj
  2. +26 −30 src/seesaw/examples/scroll.clj
  3. +106 −35 src/seesaw/scroll.clj
  4. +3 −1 src/seesaw/selection.clj
  5. +64 −1 test/seesaw/test/scroll.clj
View
@@ -1626,9 +1626,67 @@
(apply-options sp opts (merge default-options scrollable-options))))
(defn scroll!
- "TODO doc"
- [target & args]
- (apply seesaw.scroll/scroll!* (to-widget target) args))
+ "Scroll a widget. Obviously, the widget must be contained in a scrollable.
+ Returns the widget.
+
+ The basic format of the function call is:
+
+ (scroll! widget modifier argument)
+
+ widget is passed through (to-widget) as usual. Currently, the only accepted
+ value for modifier is :to. The interpretation and set of accepted values for
+ argument depends on the type of widget:
+
+ All Widgets:
+
+ :top - Scroll to the top of the widget
+ :bottom - Scroll to the bottom of the widget
+ java.awt.Point - Scroll so the given pixel point is visible
+ java.awt.Rectangle - Scroll so the given rectangle is visible
+ [:point x y] - Scroll so the given pixel point is visible
+ [:rect x y w h] - Scroll so the given rectable is visible
+
+ listboxes (JList):
+
+ [:row n] - Scroll so that row n is visible
+
+ tables (JTable):
+
+ [:row n] - Scroll so that row n is visible
+ [:column n] - Scroll so that column n is visible
+ [:cell row col] - Scroll so that the given cell is visible
+
+ text widgets:
+
+ [:line n] - Scroll so that line n is visible
+ [:position n] - Scroll so that position n (character offset) is visible
+
+ Note that for text widgets, the caret will also be moved which in turn
+ causes the selection to change.
+
+ Examples:
+
+ (scroll! w :to :top)
+ (scroll! w :to :bottom)
+ (scroll! w :to [:point 99 10])
+ (scroll! w :to [:rect 99 10 100 100])
+
+ (scroll! listbox :to [:row 99])
+
+ (scroll! table :to [:row 99])
+ (scroll! table :to [:column 10])
+ (scroll! table :to [:cell 99 10])
+
+ (scroll! text :to [:line 200])
+ (scroll! text :to [:position 2000])
+
+ See:
+ (seesaw.scroll/scroll!*)
+ (seesaw.examples.scroll)
+ "
+ [target modifier arg]
+ (seesaw.scroll/scroll!* (to-widget target) modifier arg)
+ target)
;*******************************************************************************
; Splitter
@@ -36,42 +36,25 @@
(let [t (text :multi-line? true :text "Paste a lot of text here so there's scroll bars")]
(test-panel t [(top t) (bottom t) (point t 500 500) (rect t 0 1500 50 50)])))
-(defn jlist-row [jlist]
- (let [row (text :columns 10)
- go-action (action :name "Scroll!"
- :handler (fn [e]
- (scroll! jlist :to [:row (Integer/valueOf (text row))])
- (selection! jlist (Integer/valueOf (text row)))))
- go-button (button :action go-action)]
- (bind/bind row
- (bind/transform #(format "(scroll! v :to [:row %s])" %))
- (bind/property go-button :text))
- (text! row "200")
- (horizontal-panel :items ["Row" row go-button])))
-
-(defn jlist []
- (let [jlist (listbox :model (range 0 1000))]
- (test-panel jlist [(top jlist) (bottom jlist) (jlist-row jlist)])))
-
-(defn jtable-op [jtable op-name]
+(defn test-op-int [target op-name]
(let [arg (text :columns 10)
go-action (action :name "Scroll!"
:handler (fn [e]
- (scroll! jtable :to [op-name (Integer/valueOf (text arg))])
- (selection! jtable (Integer/valueOf (text arg)))))
+ (scroll! target :to [op-name (Integer/valueOf (text arg))])
+ #_(selection! target (Integer/valueOf (text arg)))))
go-button (button :action go-action)]
(bind/bind arg
(bind/transform #(format "(scroll! v :to [%s %s])" op-name %))
(bind/property go-button :text))
(text! arg "200")
- (horizontal-panel :items [arg go-button])))
+ (horizontal-panel :items [(name op-name) arg go-button])))
-(defn jtable-op-2 [jtable op-name]
+(defn test-op-int-int [target op-name]
(let [arg0 (text :columns 10)
arg1 (text :columns 10)
go-action (action :name "Scroll!"
:handler (fn [e]
- (scroll! jtable :to [op-name
+ (scroll! target :to [op-name
(Integer/valueOf (text arg0))
(Integer/valueOf (text arg1))])))
go-button (button :action go-action)]
@@ -81,6 +64,10 @@
(text! [arg0 arg1] "20")
(horizontal-panel :items [arg0 arg1 go-button])))
+(defn jlist []
+ (let [jlist (listbox :model (range 0 1000))]
+ (test-panel jlist [(top jlist) (bottom jlist) (test-op-int jlist :row)])))
+
(defn jtable []
(let [columns (map #(-> ( format "c%09d" %) keyword) (range 26))
jtable (table :model [:columns columns
@@ -89,20 +76,29 @@
(doto jtable
(.setAutoResizeMode javax.swing.JTable/AUTO_RESIZE_OFF))
[(top jtable) (bottom jtable)
- (jtable-op jtable :row)
- (jtable-op jtable :column)
- (jtable-op-2 jtable :cell)])))
+ (test-op-int jtable :row)
+ (test-op-int jtable :column)
+ (test-op-int-int jtable :cell)])))
+
+(defn jtext[]
+ (let [t (text :multi-line? true
+ :text (apply str (interpose "\n" (range 0 1000))))]
+ (test-panel t [(top t)
+ (bottom t)
+ (test-op-int t :line)
+ (test-op-int t :position)])))
(defn app-panel []
(tabbed-panel
- :tabs [{:title "General" :content (general)}
+ :tabs [{:title "general" :content (general)}
{:title "listbox" :content (jlist)}
- {:title "table" :content (jtable)}]))
+ {:title "table" :content (jtable)}
+ {:title "text" :content (jtext)}]))
(defn -main [& args]
(invoke-later
- (-> (frame :title "Seesaw Scroll Demo" :size [600 :by 300] :content (app-panel))
+ (-> (frame :title "Seesaw Scroll Demo" :size [800 :by 400] :content (app-panel))
show!)))
-(-main)
+;(-main)
View
@@ -13,61 +13,132 @@
seesaw.scroll
(:use [seesaw.util]))
-(defprotocol ^{:private true} ScrollImpl
- (get-handlers [this arg]))
+(defn- scroll-rect-to-visible [^javax.swing.JComponent target rect]
+ (when rect
+ (.scrollRectToVisible target rect)))
(def ^{:private true} default-handlers {
- :top (fn [target] (java.awt.Rectangle. 0 0 0 0))
- :bottom (fn [^java.awt.Component target]
- (java.awt.Rectangle. 0 (.getHeight target) 0 0))
- :point (fn [target ^Integer x ^Integer y] (java.awt.Rectangle. x y 0 0))
- :rect (fn [target ^Integer x ^Integer y ^Integer w ^Integer h] (java.awt.Rectangle. x y w h))
+ ; TODO preserve current x offset for :top and bottom
+ :top
+ (fn [target]
+ (scroll-rect-to-visible target (java.awt.Rectangle. 0 0 0 0)))
+ :bottom
+ (fn [^java.awt.Component target]
+ (scroll-rect-to-visible target (java.awt.Rectangle. 0 (.getHeight target) 0 0)))
+ ; TODO :left and :right
+ :point
+ (fn [target ^Integer x ^Integer y]
+ (scroll-rect-to-visible target (java.awt.Rectangle. x y 0 0)))
+ :rect
+ (fn [target ^Integer x ^Integer y ^Integer w ^Integer h]
+ (scroll-rect-to-visible target (java.awt.Rectangle. x y w h)))
})
(def ^{:private true} list-handlers {
- :row (fn [^javax.swing.JList target ^Integer row]
- (.getCellBounds target row row))
+ :row
+ (fn [^javax.swing.JList target ^Integer row]
+ (scroll-rect-to-visible target (.getCellBounds target row row)))
})
(def ^{:private true} table-handlers {
- :row (fn [^javax.swing.JTable target ^Integer row]
- (.getCellRect target row 0 false))
- :column (fn [^javax.swing.JTable target ^Integer column]
- (.getCellRect target 0 column false))
- :cell (fn [^javax.swing.JTable target ^Integer row ^Integer column]
- (.getCellRect target row column false))
+ ; TODO preserve current column
+ :row
+ (fn [^javax.swing.JTable target ^Integer row]
+ (scroll-rect-to-visible target (.getCellRect target row 0 false)))
+ ; TODO preserve current row
+ :column
+ (fn [^javax.swing.JTable target ^Integer column]
+ (scroll-rect-to-visible target (.getCellRect target 0 column false)))
+ :cell
+ (fn [^javax.swing.JTable target ^Integer row ^Integer column]
+ (scroll-rect-to-visible target (.getCellRect target row column false)))
+})
+
+(defn- text-position-to-rect [^javax.swing.text.JTextComponent target ^Integer position]
+ (try
+ (.modelToView target position)
+ (catch javax.swing.text.BadLocationException e nil)))
+
+(defn- text-get-end-position [^javax.swing.text.JTextComponent target]
+ (.. target getDocument getEndPosition getOffset))
+
+(defn- set-caret-position [^javax.swing.text.JTextComponent target position]
+ (.setCaretPosition target position))
+
+(def ^{:private true} text-handlers {
+ ; On text, moving the caret is a better way to scroll. Otherwise, you get
+ ; weird behavior because the caret moves off-screen and will cause a jump
+ ; as soon as the user tabs to the text component and starts moving the cursor.
+ :top
+ (fn [^javax.swing.text.JTextComponent target]
+ (set-caret-position target 0))
+ :bottom
+ (fn [^java.awt.Component target]
+ (set-caret-position target (dec (text-get-end-position target))))
+ ; TODO :left and :right
+ ; TODO at some point reimplement :point and :rect in terms of caret
+ ; position
+ :line
+ (fn [^javax.swing.text.JTextComponent target ^Integer line]
+ (let [root (.. target getDocument getDefaultRootElement)]
+ (if (and (>= line 0) (< line (.getElementCount root)))
+ (set-caret-position target (.. root (getElement line) getStartOffset)))))
+
+ :position
+ (fn [^javax.swing.text.JTextComponent target ^Integer position]
+ (if (and (>= position 0) (< position (text-get-end-position target)))
+ (set-caret-position target position)))
})
-(defn- lookup-handler [handlers type]
- (if-let [h (handlers type)]
+(defn- lookup-handler [handlers op]
+ (if-let [h (handlers op)]
h
- (throw (IllegalArgumentException. (str "Unknown scroll op " type)))))
+ (throw (IllegalArgumentException. (str "Unknown scroll op " op)))))
-(defn- ^java.awt.Rectangle to-rect [target v handlers]
+(defn- canoncicalize-arg
+ "Take the arg to (scroll!*) and turn it into a vector of the form [op & args]"
+ [arg]
(cond
- (instance? java.awt.Rectangle v) v
- (instance? java.awt.Point v) (java.awt.Rectangle. ^java.awt.Point v)
- (keyword? v) ((lookup-handler handlers v) target)
- (instance? clojure.lang.PersistentVector v)
- (let [[type & args] v]
- (apply (lookup-handler handlers type) target args))))
+ (instance? java.awt.Rectangle arg)
+ (let [^java.awt.Rectangle r arg]
+ [:rect (.x r) (.y r) (.width r) (.height r)])
+ (instance? java.awt.Point arg)
+ (let [^java.awt.Point p arg]
+ [:point (.x p) (.y p)])
+ (keyword? arg) [arg]
+ (vector? arg) arg
+ :else (throw (IllegalArgumentException. (str "Unknown scroll arg format" arg)))))
-(defn- scroll-rect-to-visible [^javax.swing.JComponent target rect]
- (when rect
- (.scrollRectToVisible target rect)))
+(defprotocol ^{:private true} Scroll
+ (scroll-to [this arg]))
+
+(defn- default-scroll-to-impl [target arg handlers]
+ (let [[op & args] arg]
+ (apply (lookup-handler handlers op) target args)))
-(extend-protocol ScrollImpl
- javax.swing.JComponent (get-handlers [this arg] default-handlers)
+(extend-protocol Scroll
+ javax.swing.JComponent
+ (scroll-to [this arg]
+ (default-scroll-to-impl this arg default-handlers))
javax.swing.JList
- (get-handlers [this arg] (merge default-handlers list-handlers))
+ (scroll-to [this arg]
+ (default-scroll-to-impl this arg (merge default-handlers list-handlers)))
javax.swing.JTable
- (get-handlers [this arg] (merge default-handlers table-handlers))
+ (scroll-to [this arg]
+ (default-scroll-to-impl this arg (merge default-handlers table-handlers)))
+
+ javax.swing.text.JTextComponent
+ (scroll-to [this arg]
+ (default-scroll-to-impl this arg (merge default-handlers text-handlers)))
+
+ ; TODO implement JTree ops
)
-(defn scroll!* [target action arg]
+(defn scroll!* [target modifier arg]
(check-args (not (nil? target)) "target of scroll!* cannot be nil")
- (condp = action
- :to (scroll-rect-to-visible target (to-rect target arg (get-handlers target arg)))))
+ (condp = modifier
+ :to (scroll-to target (canoncicalize-arg arg)))
+ target)
@@ -93,9 +93,11 @@
end (.getSelectionEnd target)]
(if-not (= start end) [[start end]])))
(set-selection [target [args]]
+ (if (integer? args)
+ (.select target args args)
(if-let [[start end] args]
(.select target start end)
- (.select target 0 0))))
+ (.select target 0 0)))))
(defn selection
([target] (selection target {}))
Oops, something went wrong.

0 comments on commit e2e0c98

Please sign in to comment.