Skip to content

Commit

Permalink
Finished scroll impl for list, table, and text widgets.
Browse files Browse the repository at this point in the history
  • Loading branch information
@daveray
daveray committed Jul 24, 2011
1 parent 283c168 commit e2e0c98
Show file tree
Hide file tree
Showing 5 changed files with 260 additions and 70 deletions.
64 changes: 61 additions & 3 deletions src/seesaw/core.clj
View file
Expand Up @@ -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
Expand Down
56 changes: 26 additions & 30 deletions src/seesaw/examples/scroll.clj
View file
Expand Up @@ -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)]
Expand All @@ -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
Expand All @@ -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)

141 changes: 106 additions & 35 deletions src/seesaw/scroll.clj
View file
Expand Up @@ -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)

4 changes: 3 additions & 1 deletion src/seesaw/selection.clj
View file
Expand Up @@ -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 {}))
Expand Down

0 comments on commit e2e0c98

Please sign in to comment.