From f4523ad2de5fe988c50d1872102ff4a4d1412cfb Mon Sep 17 00:00:00 2001 From: Jon Date: Fri, 18 May 2012 11:11:38 -0700 Subject: [PATCH 01/11] begin transition to seeaw format starting with layout conversion --- project.clj | 1 + src/clooj/core.clj | 59 ++++++++++++++++++++++++++-------------------- 2 files changed, 35 insertions(+), 25 deletions(-) diff --git a/project.clj b/project.clj index 17017fc..63f216f 100644 --- a/project.clj +++ b/project.clj @@ -6,5 +6,6 @@ [slamhound "1.2.0"] [com.cemerick/pomegranate "0.0.11"] [com.fifesoft/rsyntaxtextarea "2.0.2"] + [seesaw "1.4.0"] ] ) diff --git a/src/clooj/core.clj b/src/clooj/core.clj index 3c22650..6146263 100644 --- a/src/clooj/core.clj +++ b/src/clooj/core.clj @@ -24,7 +24,10 @@ BufferedWriter OutputStreamWriter FileOutputStream) (org.fife.ui.rsyntaxtextarea RSyntaxTextArea SyntaxConstants TokenMakerFactory) (org.fife.ui.rtextarea RTextScrollPane)) - (:use [clojure.pprint :only (pprint)] + + (:use [seesaw core graphics] + + [clojure.pprint :only (pprint)] [clooj.brackets] [clooj.highlighting] [clooj.repl] @@ -308,6 +311,10 @@ ;; build gui +(defn make-tabbed-pane [text-area] + (doto (tabbed-panel :placement :top) + (.addTab "Tab Test" text-area))) + (defn make-scroll-pane [text-area] (RTextScrollPane. text-area)) @@ -384,9 +391,15 @@ (fun))))) (defn create-app [] - (let [doc-text-area (make-text-area false) - doc-text-panel (JPanel.) - doc-label (JLabel. "Source Editor") + (let [ + arglist-label (create-arglist-label) + search-text-area (text) + pos-label (label) + doc-text-area (make-text-area false) + doc-scroll-pane (make-scroll-pane doc-text-area) + doc-tabbed-pane (make-tabbed-pane doc-scroll-pane) + doc-label (label "Source Editor") + doc-text-panel (vertical-panel :items [doc-label doc-tabbed-pane pos-label search-text-area arglist-label]) repl-out-text-area (make-text-area true) repl-out-writer (make-repl-writer repl-out-text-area) repl-in-text-area (make-text-area false) @@ -396,16 +409,13 @@ completion-label (JLabel. "Name search") completion-list (JList.) completion-scroll-pane (JScrollPane. completion-list) - search-text-area (JTextField.) - arglist-label (create-arglist-label) - pos-label (JLabel.) frame (JFrame.) cp (.getContentPane frame) layout (SpringLayout.) - docs-tree (JTree.) + docs-tree (tree) docs-tree-scroll-pane (JScrollPane. docs-tree) - docs-tree-panel (JPanel.) - docs-tree-label (JLabel. "Projects") + docs-tree-label (label "Projects") + docs-tree-panel (flow-panel) doc-split-pane (make-split-pane docs-tree-panel doc-text-panel true gap 0.25) @@ -444,20 +454,19 @@ completion-list completion-scroll-pane completion-panel - )) - doc-scroll-pane (make-scroll-pane doc-text-area)] + ))] (doto frame (.setBounds 25 50 950 700) (.setLayout layout) (.add split-pane) (.setTitle (str "clooj " (get-clooj-version)))) - (doto doc-text-panel - (.setLayout (SpringLayout.)) - (.add doc-scroll-pane) - (.add doc-label) - (.add pos-label) - (.add search-text-area) - (.add arglist-label)) + ; (doto doc-text-panel + ; (.setLayout (SpringLayout.)) + ; (.add doc-scroll-pane) + ; (.add doc-label) + ; (.add pos-label) + ; (.add search-text-area) + ; (.add arglist-label)) (doto docs-tree-panel (.setLayout (SpringLayout.)) (.add docs-tree-label) @@ -491,11 +500,11 @@ SyntaxConstants/SYNTAX_STYLE_CLOJURE) (.setModel docs-tree (DefaultTreeModel. nil)) (constrain-to-parent split-pane :n gap :w gap :s (- gap) :e (- gap)) - (constrain-to-parent doc-label :n 0 :w 0 :n 15 :e 0) - (constrain-to-parent doc-scroll-pane :n 16 :w 0 :s -16 :e 0) - (constrain-to-parent pos-label :s -14 :w 0 :s 0 :w 100) - (constrain-to-parent search-text-area :s -15 :w 80 :s 0 :w 300) - (constrain-to-parent arglist-label :s -14 :w 80 :s -1 :e -10) + ; (constrain-to-parent doc-label :n 0 :w 0 :n 15 :e 0) + ; (constrain-to-parent doc-scroll-pane :n 16 :w 0 :s -16 :e 0) + ; (constrain-to-parent pos-label :s -14 :w 0 :s 0 :w 100) + ; (constrain-to-parent search-text-area :s -15 :w 80 :s 0 :w 300) + ; (constrain-to-parent arglist-label :s -14 :w 80 :s -1 :e -10) (.layoutContainer layout frame) (exit-if-closed frame) (setup-search-text-area app) @@ -538,7 +547,7 @@ (do (let [txt (slurp file-to-open) rdr (StringReader. txt)] (.read text-area rdr nil)) - (.setText doc-label (str "Source Editor \u2014 " (.getPath file))) + (.setText doc-label (str "Source Editor \u2014 " (.getName file))) (.setEditable text-area true) (.setSyntaxEditingStyle text-area (if (.endsWith (.getName file-to-open) ".clj") From 2c95434e524d574c4849ce0c85f0faadf82a0e20 Mon Sep 17 00:00:00 2001 From: Jon Date: Sat, 19 May 2012 12:12:35 -0700 Subject: [PATCH 02/11] remove more interop and reconfig layout to get rid of SpringLayout --- src/clooj/core.clj | 138 ++++++++++++++++++++++----------------------- 1 file changed, 69 insertions(+), 69 deletions(-) diff --git a/src/clooj/core.clj b/src/clooj/core.clj index 6146263..1c3bb9f 100644 --- a/src/clooj/core.clj +++ b/src/clooj/core.clj @@ -311,9 +311,8 @@ ;; build gui -(defn make-tabbed-pane [text-area] - (doto (tabbed-panel :placement :top) - (.addTab "Tab Test" text-area))) +(defn make-tabbed-pane [text-area label] + (tabbed-panel :placement :top :tabs [{:title label :content text-area}])) (defn make-scroll-pane [text-area] (RTextScrollPane. text-area)) @@ -393,40 +392,60 @@ (defn create-app [] (let [ arglist-label (create-arglist-label) - search-text-area (text) + + search-text-area (text :size [200 :by 15]) pos-label (label) + position-search-panel (border-panel :hgap 15 :west pos-label :center search-text-area) + + doc-label (label "Source Editor") doc-text-area (make-text-area false) doc-scroll-pane (make-scroll-pane doc-text-area) - doc-tabbed-pane (make-tabbed-pane doc-scroll-pane) - doc-label (label "Source Editor") - doc-text-panel (vertical-panel :items [doc-label doc-tabbed-pane pos-label search-text-area arglist-label]) - repl-out-text-area (make-text-area true) - repl-out-writer (make-repl-writer repl-out-text-area) - repl-in-text-area (make-text-area false) + doc-tabbed-pane (make-tabbed-pane doc-scroll-pane doc-label) + doc-text-panel (vertical-panel :items [doc-label doc-tabbed-pane position-search-panel arglist-label]) + help-text-area (make-text-area true) - help-text-scroll-pane (JScrollPane. help-text-area) - completion-panel (JPanel.) - completion-label (JLabel. "Name search") + help-text-scroll-pane (scrollable help-text-area) + + completion-label (label "Name search") completion-list (JList.) - completion-scroll-pane (JScrollPane. completion-list) - frame (JFrame.) - cp (.getContentPane frame) + completion-scroll-pane (scrollable completion-list) + completion-panel (vertical-panel :items [completion-label completion-scroll-pane]) + + + cp (:content-pane frame) layout (SpringLayout.) + docs-tree (tree) - docs-tree-scroll-pane (JScrollPane. docs-tree) + docs-tree-scroll-pane (scrollable docs-tree) docs-tree-label (label "Projects") - docs-tree-panel (flow-panel) - doc-split-pane (make-split-pane + docs-tree-panel (vertical-panel :items [docs-tree-label docs-tree-scroll-pane]) + + doc-split-pane (left-right-split docs-tree-panel - doc-text-panel true gap 0.25) - repl-out-scroll-pane (JScrollPane. repl-out-text-area) - repl-split-pane (make-split-pane - repl-out-scroll-pane - (make-scroll-pane repl-in-text-area) false gap 0.75) - repl-panel (JPanel.) - repl-label (JLabel. "Clojure REPL output") - repl-input-label (JLabel. "Clojure REPL input \u2191") - split-pane (make-split-pane doc-split-pane repl-panel true gap 0.5) + doc-text-panel) + + repl-out-text-area (make-text-area false) + repl-out-writer (make-repl-writer repl-out-text-area) + + repl-out-scroll-pane (scrollable repl-out-text-area) + repl-label (label "Clojure REPL output") + repl-output-vertical-panel (vertical-panel :items [repl-out-scroll-pane repl-label]) + + repl-in-text-area (make-text-area false) + repl-input-label (label "Clojure REPL input \u2191") + repl-input-vertical-panel (vertical-panel :items [repl-in-text-area repl-input-label]) + + repl-split-pane (top-bottom-split repl-output-vertical-panel repl-input-vertical-panel) + + split-pane (top-bottom-split doc-split-pane repl-split-pane) + + frame (frame + :title "Overtone sketch" + :width 950 + :height 700 + :minimum-size [500 :by 350] + :content split-pane) + app (merge {:file (atom nil) :repl (atom (create-outside-repl repl-out-writer nil)) :changed false} @@ -453,73 +472,54 @@ arglist-label completion-list completion-scroll-pane - completion-panel - ))] - (doto frame - (.setBounds 25 50 950 700) - (.setLayout layout) - (.add split-pane) - (.setTitle (str "clooj " (get-clooj-version)))) - ; (doto doc-text-panel - ; (.setLayout (SpringLayout.)) - ; (.add doc-scroll-pane) - ; (.add doc-label) - ; (.add pos-label) - ; (.add search-text-area) - ; (.add arglist-label)) - (doto docs-tree-panel - (.setLayout (SpringLayout.)) - (.add docs-tree-label) - (.add docs-tree-scroll-pane)) - (doto repl-panel - (.setLayout (SpringLayout.)) - (.add repl-label) - (.add repl-input-label) - (.add repl-split-pane)) - (doto completion-panel - (.setLayout (SpringLayout.)) - (.add completion-label) - (.add completion-scroll-pane)) + completion-panel))] + + + (doto doc-text-area attach-navigation-keys) - (constrain-to-parent completion-label :n 0 :w 0 :n 15 :e 0) - (constrain-to-parent completion-scroll-pane :n 16 :w 0 :s 0 :e 0) - (constrain-to-parent repl-label :n 0 :w 0 :n 15 :e 0) - (constrain-to-parent repl-input-label :s -15 :w 0 :s 0 :e 0) - (constrain-to-parent repl-split-pane :n 16 :w 0 :s -16 :e 0) - (constrain-to-parent docs-tree-label :n 0 :w 0 :n 15 :e 0) - (constrain-to-parent docs-tree-scroll-pane :n 16 :w 0 :s 0 :e 0) + (setup-completion-list completion-list app) + (doto pos-label (.setFont (Font. "Courier" Font/PLAIN 13))) + (double-click-selector doc-text-area) + (doto repl-in-text-area double-click-selector attach-navigation-keys) + (.setSyntaxEditingStyle repl-in-text-area SyntaxConstants/SYNTAX_STYLE_CLOJURE) + (.setModel docs-tree (DefaultTreeModel. nil)) - (constrain-to-parent split-pane :n gap :w gap :s (- gap) :e (- gap)) - ; (constrain-to-parent doc-label :n 0 :w 0 :n 15 :e 0) - ; (constrain-to-parent doc-scroll-pane :n 16 :w 0 :s -16 :e 0) - ; (constrain-to-parent pos-label :s -14 :w 0 :s 0 :w 100) - ; (constrain-to-parent search-text-area :s -15 :w 80 :s 0 :w 300) - ; (constrain-to-parent arglist-label :s -14 :w 80 :s -1 :e -10) - (.layoutContainer layout frame) + (exit-if-closed frame) + (setup-search-text-area app) + (add-caret-listener doc-text-area #(display-caret-position app)) + (activate-caret-highlighter app) + (setup-temp-writer app) + (attach-action-keys doc-text-area ["cmd1 ENTER" #(send-selected-to-repl app)]) + (doto repl-out-text-area (.setEditable false)) + (doto help-text-area (.setEditable false) (.setBackground (Color. 0xFF 0xFF 0xE8))) + (setup-autoindent repl-in-text-area) + (setup-tab-help app doc-text-area) + (dorun (map #(attach-global-action-keys % app) [docs-tree doc-text-area repl-in-text-area repl-out-text-area (.getContentPane frame)])) + (setup-autoindent doc-text-area) app)) From 814baa2555d3da9f023804c7fdab65b0eebc53a5 Mon Sep 17 00:00:00 2001 From: Jon Date: Sun, 20 May 2012 15:21:38 -0700 Subject: [PATCH 03/11] revert back to single pane doc text editor --- src/clooj/core.clj | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/clooj/core.clj b/src/clooj/core.clj index 1c3bb9f..571f0ae 100644 --- a/src/clooj/core.clj +++ b/src/clooj/core.clj @@ -311,8 +311,8 @@ ;; build gui -(defn make-tabbed-pane [text-area label] - (tabbed-panel :placement :top :tabs [{:title label :content text-area}])) +; (defn make-tabbed-pane [text-area label] +; (tabbed-panel :placement :top :tabs [{:title label :content text-area}])) (defn make-scroll-pane [text-area] (RTextScrollPane. text-area)) @@ -400,8 +400,8 @@ doc-label (label "Source Editor") doc-text-area (make-text-area false) doc-scroll-pane (make-scroll-pane doc-text-area) - doc-tabbed-pane (make-tabbed-pane doc-scroll-pane doc-label) - doc-text-panel (vertical-panel :items [doc-label doc-tabbed-pane position-search-panel arglist-label]) + ; doc-tabbed-pane (vertical-panel doc-scroll-pane doc-label) + doc-text-panel (vertical-panel :items [doc-label doc-scroll-pane position-search-panel arglist-label]) help-text-area (make-text-area true) help-text-scroll-pane (scrollable help-text-area) @@ -411,13 +411,14 @@ completion-scroll-pane (scrollable completion-list) completion-panel (vertical-panel :items [completion-label completion-scroll-pane]) - cp (:content-pane frame) - layout (SpringLayout.) docs-tree (tree) docs-tree-scroll-pane (scrollable docs-tree) - docs-tree-label (label "Projects") + docs-tree-label (border-panel + :west (label "Projects") + :size [200 :by 15] + :vgap 5) docs-tree-panel (vertical-panel :items [docs-tree-label docs-tree-scroll-pane]) doc-split-pane (left-right-split From 59ebda13c518d1f4757dcdddc3591473da3b86a7 Mon Sep 17 00:00:00 2001 From: Jon Date: Mon, 21 May 2012 14:38:33 -0700 Subject: [PATCH 04/11] update snapshot in project.clj --- project.clj | 8 +++----- src/clooj/core.clj | 4 ++-- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/project.clj b/project.clj index 63f216f..2473889 100644 --- a/project.clj +++ b/project.clj @@ -1,11 +1,9 @@ -(defproject clooj "0.3.4" - :description "clooj, a small IDE for clojure" +(defproject clooj "0.3.4.1-SNAPSHOT" + :description "the start of a seesaw version of clooj, a small IDE for clojure" :main clooj.core :dependencies [[clojure "1.3.0"] [clj-inspector "0.0.12"] [slamhound "1.2.0"] [com.cemerick/pomegranate "0.0.11"] [com.fifesoft/rsyntaxtextarea "2.0.2"] - [seesaw "1.4.0"] - ] -) + [seesaw "1.4.0"]]) diff --git a/src/clooj/core.clj b/src/clooj/core.clj index 571f0ae..5bd77dc 100644 --- a/src/clooj/core.clj +++ b/src/clooj/core.clj @@ -358,7 +358,6 @@ (select menu File > New...)
 2. edit an existing file by selecting one at left.") - (defn open-project [app] (when-let [dir (choose-directory (app :f) "Choose a project directory")] (let [project-dir (if (= (.getName dir) "src") (.getParentFile dir) dir)] @@ -444,6 +443,7 @@ :title "Overtone sketch" :width 950 :height 700 + :on-close :exit :minimum-size [500 :by 350] :content split-pane) @@ -496,7 +496,7 @@ (.setModel docs-tree (DefaultTreeModel. nil)) - (exit-if-closed frame) + ; (exit-if-closed frame) (setup-search-text-area app) From ea244c785addb0870694b9a1f0dafef4caf3263c Mon Sep 17 00:00:00 2001 From: Jon Date: Mon, 21 May 2012 15:52:53 -0700 Subject: [PATCH 05/11] pull application creation out from components in dev_tools.clj --- src/clooj/core.clj | 699 +++------------------------------------- src/clooj/dev_tools.clj | 656 +++++++++++++++++++++++++++++++++++++ src/clooj/project.clj | 2 +- 3 files changed, 700 insertions(+), 657 deletions(-) create mode 100644 src/clooj/dev_tools.clj diff --git a/src/clooj/core.clj b/src/clooj/core.clj index 5bd77dc..26b9e90 100644 --- a/src/clooj/core.clj +++ b/src/clooj/core.clj @@ -4,6 +4,19 @@ ; arthuredelstein@gmail.com (ns clooj.core + (:use [seesaw core graphics color] + [clojure.pprint :only (pprint)] + [clooj.dev-tools] + [clooj.brackets] + [clooj.highlighting] + [clooj.repl] + [clooj.search] + [clooj.help] + [clooj.project] + [clooj.utils] + [clooj.indent] + [clooj.style] + [clooj.navigate]) (:import (javax.swing AbstractListModel BorderFactory JDialog JFrame JLabel JList JMenuBar JOptionPane JPanel JScrollPane JSplitPane JTextArea @@ -22,391 +35,31 @@ (java.util Map) (java.io File FileReader StringReader BufferedWriter OutputStreamWriter FileOutputStream) - (org.fife.ui.rsyntaxtextarea RSyntaxTextArea SyntaxConstants TokenMakerFactory) - (org.fife.ui.rtextarea RTextScrollPane)) - - (:use [seesaw core graphics] - - [clojure.pprint :only (pprint)] - [clooj.brackets] - [clooj.highlighting] - [clooj.repl] - [clooj.search] - [clooj.help :only (arglist-from-caret-pos show-tab-help setup-tab-help - setup-completion-list help-handle-caret-move - find-focused-text-pane - token-from-caret-pos)] - [clooj.project :only (add-project load-tree-selection - load-expanded-paths load-project-set - save-expanded-paths - save-tree-selection get-temp-file - get-selected-projects - get-selected-file-path - remove-selected-project update-project-tree - rename-project set-tree-selection - get-code-files get-selected-namespace)] - [clooj.utils :only (clooj-prefs write-value-to-prefs read-value-from-prefs - is-mac count-while add-text-change-listener - set-selection scroll-to-pos add-caret-listener - attach-child-action-keys attach-action-keys - get-caret-coords add-menu - add-menu-item - choose-file choose-directory - comment-out uncomment-out - indent unindent awt-event persist-window-shape - confirmed? create-button is-win - get-keystroke printstream-to-writer - focus-in-text-component - scroll-to-caret when-lets - constrain-to-parent make-split-pane - gen-map on-click - remove-text-change-listeners get-text-str - scroll-to-line get-directories)] - [clooj.indent :only (setup-autoindent fix-indent-selected-lines)] - [clooj.style :only (get-monospaced-fonts show-font-window)] - [clooj.navigate :only (attach-navigation-keys)]) - (:require [clojure.main :only (repl repl-prompt)] - [clojure.set]) - (:gen-class - :methods [^{:static true} [show [] void]])) - - -(def gap 5) - -(def embedded (atom false)) - -(def changing-file (atom false)) - -(defprotocol DynamicWordHighlighter - (addWordToHighlight [this word token-type])) - -(extend-type RSyntaxTextArea - DynamicWordHighlighter - (addWordToHighlight [word token-type])) - -(defn make-rsyntax-text-area [] - (let [tmf (TokenMakerFactory/getDefaultInstance) - token-maker (.getTokenMaker tmf "text/clojure") - token-map (.getWordsToHighlight token-maker) - rsta (proxy [RSyntaxTextArea] [] - (addWordToHighlight [word token-type] - (do - (.put token-map word token-type) - token-type)))] - (.. rsta getDocument (setTokenMakerFactory tmf)) - rsta)) - -(defn make-text-area [wrap] - (doto (RSyntaxTextArea.) - (.setAnimateBracketMatching false) - (.setBracketMatchingEnabled false) - (.setAutoIndentEnabled false) - )) - -(def get-clooj-version - (memoize - (fn [] - (try - (-> (Thread/currentThread) .getContextClassLoader - (.getResource "clooj/core.class") .toString - (.replace "clooj/core.class" "project.clj") - URL. slurp read-string (nth 2)) - (catch Exception _ nil))))) - -;; font - -(defonce current-font (atom nil)) - -(defn font [name size] - (Font. name Font/PLAIN size)) - -(def default-font - (cond (is-mac) ["Monaco" 11] - (is-win) ["Courier New" 12] - :else ["Monospaced" 12])) - -(defn set-font - ([app font-name size] - (let [f (font font-name size)] - (awt-event - (write-value-to-prefs clooj-prefs "app-font" - [font-name size]) - (dorun (map #(.setFont (app %) f) - [:doc-text-area :repl-in-text-area - :repl-out-text-area :arglist-label - :search-text-area :help-text-area - :completion-list])) - (reset! current-font [font-name size])))) - ([app font-name] - (let [size (second @current-font)] - (set-font app font-name size)))) - -(defn load-font [app] - (apply set-font app (or (read-value-from-prefs clooj-prefs "app-font") - default-font))) - -(defn resize-font [app fun] - (let [[name size] @current-font] - (set-font app name (fun size)))) - -(defn grow-font [app] (resize-font app inc)) - -(defn shrink-font [app] (resize-font app dec)) - -;; caret finding - -(def highlight-agent (agent nil)) - -(def arglist-agent (agent nil)) - -(def caret-position (atom nil)) - -(defn save-caret-position [app] - (when-lets [text-area (app :doc-text-area) - pos (get @caret-position text-area) - file @(:file app)] - (when-not (.isDirectory file) - (let [key-str (str "caret_" (.hashCode (.getAbsolutePath file)))] - (write-value-to-prefs clooj-prefs key-str pos))))) - -(defn load-caret-position [app] - (when-lets [text-area (app :doc-text-area) - file @(:file app)] - (when-not (.isDirectory file) - (when-lets [key-str (str "caret_" (.hashCode (.getAbsolutePath file))) - pos (read-value-from-prefs clooj-prefs key-str)] - (let [length (.. text-area getDocument getLength) - pos2 (Math/min pos length)] - (.setCaretPosition text-area pos2) - (scroll-to-caret text-area)))))) - -(defn update-caret-position [text-comp] - (swap! caret-position assoc text-comp (.getCaretPosition text-comp))) - -(defn display-caret-position [app] - (let [{:keys [row col]} (get-caret-coords (:doc-text-area app))] - (.setText (:pos-label app) (str " " (inc row) "|" (inc col))))) - -(defn handle-caret-move [app text-comp ns] - (update-caret-position text-comp) - (help-handle-caret-move app text-comp) - (send-off highlight-agent - (fn [old-pos] - (try - (let [pos (@caret-position text-comp) - text (get-text-str text-comp)] - (when-not (= pos old-pos) - (let [enclosing-brackets (find-enclosing-brackets text pos) - bad-brackets (find-bad-brackets text) - good-enclosures (clojure.set/difference - (set enclosing-brackets) (set bad-brackets))] - (awt-event - (highlight-brackets text-comp good-enclosures bad-brackets))))) - (catch Throwable t (.printStackTrace t))))) - (when ns - (send-off arglist-agent - (fn [old-pos] - (try - (let [pos (@caret-position text-comp) - text (get-text-str text-comp)] - (when-not (= pos old-pos) - (let [arglist-text - (arglist-from-caret-pos app ns text pos)] - (awt-event (.setText (:arglist-label app) arglist-text))))) - (catch Throwable t (.printStackTrace t))))))) - -;; highlighting - -(defn activate-caret-highlighter [app] - (when-let [text-comp (app :doc-text-area)] - (let [f #(handle-caret-move app text-comp (get-file-ns app))] - (add-caret-listener text-comp f) - (add-text-change-listener text-comp f))) - (when-let [text-comp (app :repl-in-text-area)] - (let [f #(handle-caret-move app text-comp (get-repl-ns app))] - (add-caret-listener text-comp f) - (add-text-change-listener text-comp f)))) + (org.fife.ui.rsyntaxtextarea RSyntaxTextArea SyntaxConstants TokenMakerFactory) + (org.fife.ui.rtextarea RTextScrollPane))) -;; double-click paren to select form - -(defn double-click-selector [text-comp] - (.addMouseListener text-comp - (proxy [MouseAdapter] [] - (mouseClicked [e] - (when (== 2 (.getClickCount e)) - (when-lets [pos (.viewToModel text-comp (.getPoint e)) - c (.. text-comp getDocument (getText pos 1) (charAt 0)) - pos (cond (#{\( \[ \{ \"} c) (inc pos) - (#{\) \] \} \"} c) pos) - [a b] (find-enclosing-brackets (get-text-str text-comp) pos)] - (set-selection text-comp a (inc b)))))))) - -;; temp files - -(defn dump-temp-doc [app orig-f txt] - (try - (when orig-f - (let [orig (.getAbsolutePath orig-f) - f (.getAbsolutePath (get-temp-file orig-f))] - (spit f txt) - (awt-event (.updateUI (app :docs-tree))))) - (catch Exception e nil))) - -(def temp-file-manager (agent 0)) - -(defn update-temp [app] - (let [text-comp (app :doc-text-area) - txt (get-text-str text-comp) - f @(app :file)] - (send-off temp-file-manager - (fn [old-pos] - (try - (when-let [pos (get @caret-position text-comp)] - (when-not (= old-pos pos) - (dump-temp-doc app f txt)) - pos) - (catch Throwable t (awt-event (.printStackTrace t)))))))) - -(defn setup-temp-writer [app] - (let [text-comp (:doc-text-area app)] - (add-text-change-listener text-comp - #(when-not @changing-file - (update-caret-position text-comp) - (update-temp app))))) - -(declare restart-doc) - -(defn file-suffix [^File f] - (when-lets [name (.getName f) - last-dot (.lastIndexOf name ".") - suffix (.substring name (inc last-dot))] - suffix)) - -(defn text-file? [f] - (not (some #{(file-suffix f)} - ["jar" "class" "dll" "jpg" "png" "bmp"]))) - -(defn setup-tree [app] - (let [tree (:docs-tree app) - save #(save-expanded-paths tree)] - (doto tree - (.setRootVisible false) - (.setShowsRootHandles true) - (.. getSelectionModel (setSelectionMode TreeSelectionModel/SINGLE_TREE_SELECTION)) - (.addTreeExpansionListener - (reify TreeExpansionListener - (treeCollapsed [this e] (save)) - (treeExpanded [this e] (save)))) - (.addTreeSelectionListener - (reify TreeSelectionListener - (valueChanged [this e] - (awt-event - (save-tree-selection tree (.getNewLeadSelectionPath e)) - (let [f (.. e getPath getLastPathComponent - getUserObject)] - (when (and - (not= f @(app :file)) - (text-file? f)) - (restart-doc app f)))))))))) - -;; build gui - -; (defn make-tabbed-pane [text-area label] -; (tabbed-panel :placement :top :tabs [{:title label :content text-area}])) - -(defn make-scroll-pane [text-area] - (RTextScrollPane. text-area)) - -(defn setup-search-text-area [app] - (let [sta (doto (app :search-text-area) - (.setVisible false) - (.setBorder (BorderFactory/createLineBorder Color/DARK_GRAY)) - (.addFocusListener (proxy [FocusAdapter] [] (focusLost [_] (stop-find app)))))] - (add-text-change-listener sta #(update-find-highlight app false)) - (attach-action-keys sta ["ENTER" #(highlight-step app false)] - ["shift ENTER" #(highlight-step app true)] - ["ESCAPE" #(escape-find app)]))) - -(defn create-arglist-label [] - (doto (JLabel.) - (.setVisible true) - )) - -(defn exit-if-closed [^java.awt.Window f] - (when-not @embedded - (.addWindowListener f - (proxy [WindowAdapter] [] - (windowClosing [_] - (System/exit 0)))))) - -(def no-project-txt - "\n Welcome to clooj, a lightweight IDE for clojure\n - To start coding, you can either\n - a. create a new project - (select the Project > New... menu), or - b. open an existing project - (select the Project > Open... menu)\n - and then either\n - a. create a new file - (select the File > New menu), or - b. open an existing file - (click on it in the tree at left).") - -(def no-file-txt - "To edit source code you need to either:
-  1. create a new file - (select menu File > New...)
-  2. edit an existing file by selecting one at left.") - -(defn open-project [app] - (when-let [dir (choose-directory (app :f) "Choose a project directory")] - (let [project-dir (if (= (.getName dir) "src") (.getParentFile dir) dir)] - (write-value-to-prefs clooj-prefs "last-open-dir" (.getAbsolutePath (.getParentFile project-dir))) - (add-project app (.getAbsolutePath project-dir)) - (update-project-tree (:docs-tree app)) - (when-let [clj-file (or (-> (File. project-dir "src") - .getAbsolutePath - (get-code-files ".clj") - first) - project-dir)] - (awt-event (set-tree-selection (app :docs-tree) (.getAbsolutePath clj-file))))))) - -(defn attach-global-action-keys [comp app] - (attach-action-keys comp - ["cmd1 EQUALS" #(grow-font app)] - ["cmd1 shift EQUALS" #(grow-font app)] - ["cmd1 PLUS" #(grow-font app)] - ["cmd2 MINUS" #(.toBack (:frame app))] - ["cmd2 PLUS" #(.toFront (:frame app))] - ["cmd2 EQUALS" #(.toFront (:frame app))] - ["cmd1 shift O" #(open-project app)] - ["cmd1 K"#(.setText (app :repl-out-text-area) "")])) - -(defn on-window-activation [win fun] - (.addWindowListener win - (proxy [WindowAdapter] [] - (windowActivated [_] - (fun))))) (defn create-app [] (let [ - arglist-label (create-arglist-label) + arglist-label (label) - search-text-area (text :size [200 :by 15]) - pos-label (label) - position-search-panel (border-panel :hgap 15 :west pos-label :center search-text-area) + search-text-area (text :size [200 :by 12]) + pos-label (label :font (font "COURIER" 13)) + position-search-panel (border-panel + :west pos-label + :center search-text-area + :hgap 15) doc-label (label "Source Editor") doc-text-area (make-text-area false) doc-scroll-pane (make-scroll-pane doc-text-area) - ; doc-tabbed-pane (vertical-panel doc-scroll-pane doc-label) - doc-text-panel (vertical-panel :items [doc-label doc-scroll-pane position-search-panel arglist-label]) + doc-text-panel (vertical-panel :items [doc-label doc-scroll-pane position-search-panel]) help-text-area (make-text-area true) help-text-scroll-pane (scrollable help-text-area) completion-label (label "Name search") - completion-list (JList.) + completion-list (listbox ) completion-scroll-pane (scrollable completion-list) completion-panel (vertical-panel :items [completion-label completion-scroll-pane]) @@ -418,26 +71,33 @@ :west (label "Projects") :size [200 :by 15] :vgap 5) - docs-tree-panel (vertical-panel :items [docs-tree-label docs-tree-scroll-pane]) + docs-tree-panel (vertical-panel + :items [docs-tree-label + docs-tree-scroll-pane]) doc-split-pane (left-right-split docs-tree-panel - doc-text-panel) + doc-text-panel + :divider-location 0.2) repl-out-text-area (make-text-area false) repl-out-writer (make-repl-writer repl-out-text-area) repl-out-scroll-pane (scrollable repl-out-text-area) - repl-label (label "Clojure REPL output") - repl-output-vertical-panel (vertical-panel :items [repl-out-scroll-pane repl-label]) + repl-output-vertical-panel (vertical-panel :items [repl-out-scroll-pane]) repl-in-text-area (make-text-area false) - repl-input-label (label "Clojure REPL input \u2191") - repl-input-vertical-panel (vertical-panel :items [repl-in-text-area repl-input-label]) + repl-input-vertical-panel (vertical-panel :items [repl-in-text-area]) - repl-split-pane (top-bottom-split repl-output-vertical-panel repl-input-vertical-panel) + repl-split-pane (top-bottom-split + repl-output-vertical-panel + repl-input-vertical-panel + :divider-location 0.7) - split-pane (top-bottom-split doc-split-pane repl-split-pane) + split-pane (top-bottom-split + doc-split-pane + repl-split-pane + :divider-location 0.7) frame (frame :title "Overtone sketch" @@ -455,7 +115,6 @@ doc-label repl-out-text-area repl-in-text-area - repl-label frame help-text-area help-text-scroll-pane @@ -481,9 +140,7 @@ attach-navigation-keys) (setup-completion-list completion-list app) - - (doto pos-label - (.setFont (Font. "Courier" Font/PLAIN 13))) + (double-click-selector doc-text-area) @@ -512,7 +169,7 @@ (doto repl-out-text-area (.setEditable false)) (doto help-text-area (.setEditable false) - (.setBackground (Color. 0xFF 0xFF 0xE8))) + (.setBackground (color 0xFF 0xFF 0xE8))) (setup-autoindent repl-in-text-area) @@ -524,287 +181,17 @@ (setup-autoindent doc-text-area) app)) -;; clooj docs - -(defn restart-doc [app ^File file] - (send-off temp-file-manager - (let [f @(:file app) - txt (get-text-str (:doc-text-area app))] - (let [temp-file (get-temp-file f)] - (fn [_] (when (and f temp-file (.exists temp-file)) - (dump-temp-doc app f txt)) - 0)))) - (await temp-file-manager) - (let [frame (app :frame) - text-area (app :doc-text-area) - temp-file (get-temp-file file) - file-to-open (if (and temp-file (.exists temp-file)) temp-file file) - doc-label (app :doc-label)] - ;(remove-text-change-listeners text-area) - (reset! changing-file true) - (save-caret-position app) - (.. text-area getHighlighter removeAllHighlights) - (if (and file-to-open (.exists file-to-open) (.isFile file-to-open)) - (do (let [txt (slurp file-to-open) - rdr (StringReader. txt)] - (.read text-area rdr nil)) - (.setText doc-label (str "Source Editor \u2014 " (.getName file))) - (.setEditable text-area true) - (.setSyntaxEditingStyle text-area - (if (.endsWith (.getName file-to-open) ".clj") - SyntaxConstants/SYNTAX_STYLE_CLOJURE - SyntaxConstants/SYNTAX_STYLE_NONE))) - (do (.setText text-area no-project-txt) - (.setText doc-label (str "Source Editor (No file selected)")) - (.setEditable text-area false))) - (update-caret-position text-area) - (setup-autoindent text-area) - (reset! (app :file) file) - (switch-repl app (first (get-selected-projects app))) - (apply-namespace-to-repl app))) - -(defn save-file [app] - (try - (let [f @(app :file) - ft (File. (str (.getAbsolutePath f) "~"))] - (with-open [writer (BufferedWriter. - (OutputStreamWriter. - (FileOutputStream. f) - "UTF-8"))] - (.write (app :doc-text-area) writer)) - (send-off temp-file-manager (fn [_] 0)) - (.delete ft) - (.updateUI (app :docs-tree))) - (catch Exception e (JOptionPane/showMessageDialog - nil "Unable to save file." - "Oops" JOptionPane/ERROR_MESSAGE)))) - -(def project-clj-text (.trim -" -(defproject PROJECTNAME \"1.0.0-SNAPSHOT\" - :description \"FIXME: write\" - :dependencies [[org.clojure/clojure \"1.3.0\"]]) -")) - -(defn specify-source [project-dir title default-namespace] - (when-let [namespace (JOptionPane/showInputDialog nil - "Please enter a fully-qualified namespace" - title - JOptionPane/QUESTION_MESSAGE - nil - nil - default-namespace)] - (let [tokens (map munge (.split namespace "\\.")) - dirs (cons "src" (butlast tokens)) - dirstring (apply str (interpose File/separator dirs)) - name (last tokens) - the-dir (File. project-dir dirstring)] - (.mkdirs the-dir) - [(File. the-dir (str name ".clj")) namespace]))) - -(defn create-file [app project-dir default-namespace] - (when-let [[file namespace] (specify-source project-dir - "Create a source file" - default-namespace)] - (let [tree (:docs-tree app)] - (spit file (str "(ns " namespace ")\n")) - (update-project-tree (:docs-tree app)) - (set-tree-selection tree (.getAbsolutePath file))))) - -(defn new-project-clj [app project-dir] - (let [project-name (.getName project-dir) - file-text (.replace project-clj-text "PROJECTNAME" project-name)] - (spit (File. project-dir "project.clj") file-text))) - -(defn new-project [app] - (try - (when-let [dir (choose-file (app :frame) "Create a project directory" "" false)] - (awt-event - (let [path (.getAbsolutePath dir)] - (.mkdirs (File. dir "src")) - (new-project-clj app dir) - (add-project app path) - (update-project-tree (:docs-tree app)) - (set-tree-selection (app :docs-tree) path) - (create-file app dir (str (.getName dir) ".core"))))) - (catch Exception e (do (JOptionPane/showMessageDialog nil - "Unable to create project." - "Oops" JOptionPane/ERROR_MESSAGE) - (.printStackTrace e))))) - -(defn rename-file [app] - (when-let [old-file @(app :file)] - (let [tree (app :docs-tree) - [file namespace] (specify-source - (first (get-selected-projects app)) - "Rename a source file" - (get-selected-namespace tree))] - (when file - (.renameTo @(app :file) file) - (update-project-tree (:docs-tree app)) - (awt-event (set-tree-selection tree (.getAbsolutePath file))))))) - -(defn delete-file [app] - (let [path (get-selected-file-path app)] - (when (confirmed? "Are you sure you want to delete this file?\nDeleting cannot be undone." path) - (loop [f (File. path)] - (when (and (empty? (.listFiles f)) - (let [p (-> f .getParentFile .getAbsolutePath)] - (or (.contains p (str File/separator "src" File/separator)) - (.endsWith p (str File/separator "src"))))) - (.delete f) - (recur (.getParentFile f)))) - (update-project-tree (app :docs-tree))))) - -(defn remove-project [app] - (when (confirmed? "Remove the project from list? (No files will be deleted.)" - "Remove project") - (remove-selected-project app))) - -(defn revert-file [app] - (when-let [f @(:file app)] - (let [temp-file (get-temp-file f)] - (when (.exists temp-file)) - (let [path (.getAbsolutePath f)] - (when (confirmed? "Revert the file? This cannot be undone." path) - (.delete temp-file) - (update-project-tree (:docs-tree app)) - (restart-doc app f)))))) - -(defn- dir-rank [dir] - (get {"src" 0 "test" 1 "lib" 2} (.getName dir) 100)) - -(defn- find-file [project-path relative-file-path] - (let [classpath-dirs (sort-by dir-rank < (get-directories (File. project-path))) - file-candidates (map - #(File. (str (.getAbsolutePath %) File/separatorChar relative-file-path)) - classpath-dirs)] - (first (filter #(and (.exists %) (.isFile %)) file-candidates)))) - -(defn goto-definition [ns app] - (let [text-comp (:doc-text-area app) - pos (.getCaretPosition text-comp) - text (.getText text-comp) - src-file (:file (meta (do - (token-from-caret-pos ns text pos) nil))) - line (:line (meta (do (find-ns (symbol ns)) - (token-from-caret-pos ns text pos) nil))) - project-path (first (get-selected-projects app)) - file (find-file project-path src-file)] - (when (and file line) - (when (not= file @(:file app)) - (restart-doc app file) - (set-tree-selection (:docs-tree app) (.getAbsolutePath file))) - (scroll-to-line text-comp line)))) - -(defn make-menus [app] - (when (is-mac) - (System/setProperty "apple.laf.useScreenMenuBar" "true")) - (let [menu-bar (JMenuBar.)] - (. (app :frame) setJMenuBar menu-bar) - (let [file-menu - (add-menu menu-bar "File" "F" - ["New" "N" "cmd1 N" #(create-file app (first (get-selected-projects app)) "")] - ["Save" "S" "cmd1 S" #(save-file app)] - ["Move/Rename" "M" nil #(rename-file app)] - ["Revert" "R" nil #(revert-file app)] - ["Delete" nil nil #(delete-file app)])] - (when-not (is-mac) - (add-menu-item file-menu "Exit" "X" nil #(System/exit 0)))) - (add-menu menu-bar "Project" "P" - ["New..." "N" "cmd1 shift N" #(new-project app)] - ["Open..." "O" "cmd1 shift O" #(open-project app)] - ["Move/Rename" "M" nil #(rename-project app)] - ["Remove" nil nil #(remove-project app)]) - (add-menu menu-bar "Source" "U" - ["Comment-out" "C" "cmd1 SEMICOLON" #(comment-out (:doc-text-area app))] - ["Uncomment-out" "U" "cmd1 shift SEMICOLON" #(uncomment-out (:doc-text-area app))] - ["Fix indentation" "F" "cmd1 BACK_SLASH" #(fix-indent-selected-lines (:doc-text-area app))] - ["Indent lines" "I" "cmd1 CLOSE_BRACKET" #(indent (:doc-text-area app))] - ["Unindent lines" "D" "cmd1 OPEN_BRACKET" #(indent (:doc-text-area app))] - ["Name search/docs" "S" "TAB" #(show-tab-help app (find-focused-text-pane app) inc)] - ;["Go to definition" "G" "cmd1 D" #(goto-definition (get-file-ns app) app)] - ) - (add-menu menu-bar "REPL" "R" - ["Evaluate here" "E" "cmd1 ENTER" #(send-selected-to-repl app)] - ["Evaluate entire file" "F" "cmd1 E" #(send-doc-to-repl app)] - ["Apply file ns" "A" "cmd1 shift A" #(apply-namespace-to-repl app)] - ["Clear output" "C" "cmd1 K" #(.setText (app :repl-out-text-area) "")] - ["Restart" "R" "cmd1 R" #(restart-repl app - (first (get-selected-projects app)))] - ["Print stack trace for last error" "T" "cmd1 T" #(print-stack-trace app)]) - (add-menu menu-bar "Search" "S" - ["Find" "F" "cmd1 F" #(start-find app)] - ["Find next" "N" "cmd1 G" #(highlight-step app false)] - ["Find prev" "P" "cmd1 shift G" #(highlight-step app true)]) - (add-menu menu-bar "Window" "W" - ["Go to REPL input" "R" "cmd1 3" #(.requestFocusInWindow (:repl-in-text-area app))] - ["Go to Editor" "E" "cmd1 2" #(.requestFocusInWindow (:doc-text-area app))] - ["Go to Project Tree" "P" "cmd1 1" #(.requestFocusInWindow (:docs-tree app))] - ["Increase font size" nil "cmd1 PLUS" #(grow-font app)] - ["Decrease font size" nil "cmd1 MINUS" #(shrink-font app)] - ["Choose font..." nil nil #(apply show-font-window - app set-font @current-font)]))) - - -(defn add-visibility-shortcut [app] - (let [shortcuts [(map get-keystroke ["cmd2 EQUALS" "cmd2 PLUS"])]] - (.. Toolkit getDefaultToolkit - (addAWTEventListener - (proxy [AWTEventListener] [] - (eventDispatched [e] - (when (some #{(KeyStroke/getKeyStrokeForEvent e)} - shortcuts) - (.toFront (:frame app))))) - AWTEvent/KEY_EVENT_MASK)))) - -;; startup - (defonce current-app (atom nil)) -(defn startup [] - (Thread/setDefaultUncaughtExceptionHandler - (proxy [Thread$UncaughtExceptionHandler] [] - (uncaughtException [thread exception] - (println thread) (.printStackTrace exception)))) - (UIManager/setLookAndFeel (UIManager/getSystemLookAndFeelClassName)) - (let [app (create-app)] - (reset! current-app app) - (make-menus app) - (add-visibility-shortcut app) - (add-repl-input-handler app) - (setup-tab-help app (app :repl-in-text-area)) - (doall (map #(add-project app %) (load-project-set))) - (let [frame (app :frame)] - (persist-window-shape clooj-prefs "main-window" frame) - (.setVisible frame true) - (on-window-activation frame #(update-project-tree (app :docs-tree)))) - (setup-temp-writer app) - (setup-tree app) - (let [tree (app :docs-tree)] - (load-expanded-paths tree) - (load-tree-selection tree)) - (load-font app))) - (defn -show [] (reset! embedded true) (if (not @current-app) - (startup) + (startup create-app current-app) (.setVisible (:frame @current-app) true))) (defn -main [& args] (reset! embedded false) - (startup)) - -;; testing + (startup create-app current-app)) -(defn get-text [] - (get-text-str (@current-app :doc-text-area))) -; not working yet: -;(defn restart -; "Restart the application" -; [] -; (.setVisible (@current-app :frame) false) -; (startup)) diff --git a/src/clooj/dev_tools.clj b/src/clooj/dev_tools.clj new file mode 100644 index 0000000..df1f961 --- /dev/null +++ b/src/clooj/dev_tools.clj @@ -0,0 +1,656 @@ +; Copyright (c) 2011, Arthur Edelstein +; All rights reserved. +; Eclipse Public License 1.0 +; arthuredelstein@gmail.com + +(ns clooj.dev-tools + (:import (javax.swing AbstractListModel BorderFactory JDialog + JFrame JLabel JList JMenuBar JOptionPane + JPanel JScrollPane JSplitPane JTextArea + JTextField JTree KeyStroke SpringLayout JTextPane + ListSelectionModel + UIManager) + (javax.swing.event TreeSelectionListener + TreeExpansionListener) + (javax.swing.tree DefaultMutableTreeNode DefaultTreeModel + TreePath TreeSelectionModel) + (java.awt Insets Rectangle Window) + (java.awt.event AWTEventListener FocusAdapter MouseAdapter + WindowAdapter KeyAdapter) + (java.awt AWTEvent Color Font GridLayout Toolkit) + (java.net URL) + (java.util Map) + (java.io File FileReader StringReader + BufferedWriter OutputStreamWriter FileOutputStream) + (org.fife.ui.rsyntaxtextarea RSyntaxTextArea SyntaxConstants TokenMakerFactory) + (org.fife.ui.rtextarea RTextScrollPane)) + + (:use [seesaw core graphics] + + [clojure.pprint :only (pprint)] + [clooj.brackets] + [clooj.highlighting] + [clooj.repl] + [clooj.search] + [clooj.help :only (arglist-from-caret-pos show-tab-help setup-tab-help + setup-completion-list help-handle-caret-move + find-focused-text-pane + token-from-caret-pos)] + [clooj.project :only (add-project load-tree-selection + load-expanded-paths load-project-set + save-expanded-paths + save-tree-selection get-temp-file + get-selected-projects + get-selected-file-path + remove-selected-project update-project-tree + rename-project set-tree-selection + get-code-files get-selected-namespace)] + [clooj.utils :only (clooj-prefs write-value-to-prefs read-value-from-prefs + is-mac count-while add-text-change-listener + set-selection scroll-to-pos add-caret-listener + attach-child-action-keys attach-action-keys + get-caret-coords add-menu + add-menu-item + choose-file choose-directory + comment-out uncomment-out + indent unindent awt-event persist-window-shape + confirmed? create-button is-win + get-keystroke printstream-to-writer + focus-in-text-component + scroll-to-caret when-lets + constrain-to-parent make-split-pane + gen-map on-click + remove-text-change-listeners get-text-str + scroll-to-line get-directories)] + [clooj.indent :only (setup-autoindent fix-indent-selected-lines)] + [clooj.style :only (get-monospaced-fonts show-font-window)] + [clooj.navigate :only (attach-navigation-keys)]) + (:require [clojure.main :only (repl repl-prompt)] + [clojure.set]) + (:gen-class + :methods [^{:static true} [show [] void]])) + + +(def gap 5) + +(def embedded (atom false)) + +(def changing-file (atom false)) + +(defprotocol DynamicWordHighlighter + (addWordToHighlight [this word token-type])) + +(extend-type RSyntaxTextArea + DynamicWordHighlighter + (addWordToHighlight [word token-type])) + +(defn make-rsyntax-text-area [] + (let [tmf (TokenMakerFactory/getDefaultInstance) + token-maker (.getTokenMaker tmf "text/clojure") + token-map (.getWordsToHighlight token-maker) + rsta (proxy [RSyntaxTextArea] [] + (addWordToHighlight [word token-type] + (do + (.put token-map word token-type) + token-type)))] + (.. rsta getDocument (setTokenMakerFactory tmf)) + rsta)) + +(defn make-text-area [wrap] + (doto (RSyntaxTextArea.) + (.setAnimateBracketMatching false) + (.setBracketMatchingEnabled false) + (.setAutoIndentEnabled false) + )) + +(def get-clooj-version + (memoize + (fn [] + (try + (-> (Thread/currentThread) .getContextClassLoader + (.getResource "clooj/core.class") .toString + (.replace "clooj/core.class" "project.clj") + URL. slurp read-string (nth 2)) + (catch Exception _ nil))))) + +;; font + +(defonce current-font (atom nil)) + +(defn font [name size] + (Font. name Font/PLAIN size)) + +(def default-font + (cond (is-mac) ["Monaco" 11] + (is-win) ["Courier New" 12] + :else ["Monospaced" 12])) + +(defn set-font + ([app font-name size] + (let [f (font font-name size)] + (awt-event + (write-value-to-prefs clooj-prefs "app-font" + [font-name size]) + (dorun (map #(.setFont (app %) f) + [:doc-text-area :repl-in-text-area + :repl-out-text-area :arglist-label + :search-text-area :help-text-area + :completion-list])) + (reset! current-font [font-name size])))) + ([app font-name] + (let [size (second @current-font)] + (set-font app font-name size)))) + +(defn load-font [app] + (apply set-font app (or (read-value-from-prefs clooj-prefs "app-font") + default-font))) + +(defn resize-font [app fun] + (let [[name size] @current-font] + (set-font app name (fun size)))) + +(defn grow-font [app] (resize-font app inc)) + +(defn shrink-font [app] (resize-font app dec)) + +;; caret finding + +(def highlight-agent (agent nil)) + +(def arglist-agent (agent nil)) + +(def caret-position (atom nil)) + +(defn save-caret-position [app] + (when-lets [text-area (app :doc-text-area) + pos (get @caret-position text-area) + file @(:file app)] + (when-not (.isDirectory file) + (let [key-str (str "caret_" (.hashCode (.getAbsolutePath file)))] + (write-value-to-prefs clooj-prefs key-str pos))))) + +(defn load-caret-position [app] + (when-lets [text-area (app :doc-text-area) + file @(:file app)] + (when-not (.isDirectory file) + (when-lets [key-str (str "caret_" (.hashCode (.getAbsolutePath file))) + pos (read-value-from-prefs clooj-prefs key-str)] + (let [length (.. text-area getDocument getLength) + pos2 (Math/min pos length)] + (.setCaretPosition text-area pos2) + (scroll-to-caret text-area)))))) + +(defn update-caret-position [text-comp] + (swap! caret-position assoc text-comp (.getCaretPosition text-comp))) + +(defn display-caret-position [app] + (let [{:keys [row col]} (get-caret-coords (:doc-text-area app))] + (.setText (:pos-label app) (str " " (inc row) "|" (inc col))))) + +(defn handle-caret-move [app text-comp ns] + (update-caret-position text-comp) + (help-handle-caret-move app text-comp) + (send-off highlight-agent + (fn [old-pos] + (try + (let [pos (@caret-position text-comp) + text (get-text-str text-comp)] + (when-not (= pos old-pos) + (let [enclosing-brackets (find-enclosing-brackets text pos) + bad-brackets (find-bad-brackets text) + good-enclosures (clojure.set/difference + (set enclosing-brackets) (set bad-brackets))] + (awt-event + (highlight-brackets text-comp good-enclosures bad-brackets))))) + (catch Throwable t (.printStackTrace t))))) + (when ns + (send-off arglist-agent + (fn [old-pos] + (try + (let [pos (@caret-position text-comp) + text (get-text-str text-comp)] + (when-not (= pos old-pos) + (let [arglist-text + (arglist-from-caret-pos app ns text pos)] + (awt-event (.setText (:arglist-label app) arglist-text))))) + (catch Throwable t (.printStackTrace t))))))) + +;; highlighting + +(defn activate-caret-highlighter [app] + (when-let [text-comp (app :doc-text-area)] + (let [f #(handle-caret-move app text-comp (get-file-ns app))] + (add-caret-listener text-comp f) + (add-text-change-listener text-comp f))) + (when-let [text-comp (app :repl-in-text-area)] + (let [f #(handle-caret-move app text-comp (get-repl-ns app))] + (add-caret-listener text-comp f) + (add-text-change-listener text-comp f)))) + +;; double-click paren to select form + +(defn double-click-selector [text-comp] + (.addMouseListener text-comp + (proxy [MouseAdapter] [] + (mouseClicked [e] + (when (== 2 (.getClickCount e)) + (when-lets [pos (.viewToModel text-comp (.getPoint e)) + c (.. text-comp getDocument (getText pos 1) (charAt 0)) + pos (cond (#{\( \[ \{ \"} c) (inc pos) + (#{\) \] \} \"} c) pos) + [a b] (find-enclosing-brackets (get-text-str text-comp) pos)] + (set-selection text-comp a (inc b)))))))) + +;; temp files + +(defn dump-temp-doc [app orig-f txt] + (try + (when orig-f + (let [orig (.getAbsolutePath orig-f) + f (.getAbsolutePath (get-temp-file orig-f))] + (spit f txt) + (awt-event (.updateUI (app :docs-tree))))) + (catch Exception e nil))) + +(def temp-file-manager (agent 0)) + +(defn update-temp [app] + (let [text-comp (app :doc-text-area) + txt (get-text-str text-comp) + f @(app :file)] + (send-off temp-file-manager + (fn [old-pos] + (try + (when-let [pos (get @caret-position text-comp)] + (when-not (= old-pos pos) + (dump-temp-doc app f txt)) + pos) + (catch Throwable t (awt-event (.printStackTrace t)))))))) + +(defn setup-temp-writer [app] + (let [text-comp (:doc-text-area app)] + (add-text-change-listener text-comp + #(when-not @changing-file + (update-caret-position text-comp) + (update-temp app))))) + +(declare restart-doc) + +(defn file-suffix [^File f] + (when-lets [name (.getName f) + last-dot (.lastIndexOf name ".") + suffix (.substring name (inc last-dot))] + suffix)) + +(defn text-file? [f] + (not (some #{(file-suffix f)} + ["jar" "class" "dll" "jpg" "png" "bmp"]))) + +(defn setup-tree [app] + (let [tree (:docs-tree app) + save #(save-expanded-paths tree)] + (doto tree + (.setRootVisible false) + (.setShowsRootHandles true) + (.. getSelectionModel (setSelectionMode TreeSelectionModel/SINGLE_TREE_SELECTION)) + (.addTreeExpansionListener + (reify TreeExpansionListener + (treeCollapsed [this e] (save)) + (treeExpanded [this e] (save)))) + (.addTreeSelectionListener + (reify TreeSelectionListener + (valueChanged [this e] + (awt-event + (save-tree-selection tree (.getNewLeadSelectionPath e)) + (let [f (.. e getPath getLastPathComponent + getUserObject)] + (when (and + (not= f @(app :file)) + (text-file? f)) + (restart-doc app f)))))))))) + +;; build gui + +; (defn make-tabbed-pane [text-area label] +; (tabbed-panel :placement :top :tabs [{:title label :content text-area}])) + +(defn make-scroll-pane [text-area] + (RTextScrollPane. text-area)) + +(defn setup-search-text-area [app] + (let [sta (doto (app :search-text-area) + (.setVisible false) + (.setBorder (BorderFactory/createLineBorder Color/DARK_GRAY)) + (.addFocusListener (proxy [FocusAdapter] [] (focusLost [_] (stop-find app)))))] + (add-text-change-listener sta #(update-find-highlight app false)) + (attach-action-keys sta ["ENTER" #(highlight-step app false)] + ["shift ENTER" #(highlight-step app true)] + ["ESCAPE" #(escape-find app)]))) + +(defn create-arglist-label [] + (doto (JLabel.) + (.setVisible true) + )) + +(defn exit-if-closed [^java.awt.Window f] + (when-not @embedded + (.addWindowListener f + (proxy [WindowAdapter] [] + (windowClosing [_] + (System/exit 0)))))) + +(def no-project-txt + "\n Welcome to clooj, a lightweight IDE for clojure\n + To start coding, you can either\n + a. create a new project + (select the Project > New... menu), or + b. open an existing project + (select the Project > Open... menu)\n + and then either\n + a. create a new file + (select the File > New menu), or + b. open an existing file + (click on it in the tree at left).") + +(def no-file-txt + "To edit source code you need to either:
+  1. create a new file + (select menu File > New...)
+  2. edit an existing file by selecting one at left.") + +(defn open-project [app] + (when-let [dir (choose-directory (app :f) "Choose a project directory")] + (let [project-dir (if (= (.getName dir) "src") (.getParentFile dir) dir)] + (write-value-to-prefs clooj-prefs "last-open-dir" (.getAbsolutePath (.getParentFile project-dir))) + (add-project app (.getAbsolutePath project-dir)) + (update-project-tree (:docs-tree app)) + (when-let [clj-file (or (-> (File. project-dir "src") + .getAbsolutePath + (get-code-files ".clj") + first) + project-dir)] + (awt-event (set-tree-selection (app :docs-tree) (.getAbsolutePath clj-file))))))) + +(defn attach-global-action-keys [comp app] + (attach-action-keys comp + ["cmd1 EQUALS" #(grow-font app)] + ["cmd1 shift EQUALS" #(grow-font app)] + ["cmd1 PLUS" #(grow-font app)] + ["cmd2 MINUS" #(.toBack (:frame app))] + ["cmd2 PLUS" #(.toFront (:frame app))] + ["cmd2 EQUALS" #(.toFront (:frame app))] + ["cmd1 shift O" #(open-project app)] + ["cmd1 K"#(.setText (app :repl-out-text-area) "")])) + +(defn on-window-activation [win fun] + (.addWindowListener win + (proxy [WindowAdapter] [] + (windowActivated [_] + (fun))))) + +;; clooj docs + +(defn restart-doc [app ^File file] + (send-off temp-file-manager + (let [f @(:file app) + txt (get-text-str (:doc-text-area app))] + (let [temp-file (get-temp-file f)] + (fn [_] (when (and f temp-file (.exists temp-file)) + (dump-temp-doc app f txt)) + 0)))) + (await temp-file-manager) + (let [frame (app :frame) + text-area (app :doc-text-area) + temp-file (get-temp-file file) + file-to-open (if (and temp-file (.exists temp-file)) temp-file file) + doc-label (app :doc-label)] + ;(remove-text-change-listeners text-area) + (reset! changing-file true) + (save-caret-position app) + (.. text-area getHighlighter removeAllHighlights) + (if (and file-to-open (.exists file-to-open) (.isFile file-to-open)) + (do (let [txt (slurp file-to-open) + rdr (StringReader. txt)] + (.read text-area rdr nil)) + (.setText doc-label (str "Source Editor \u2014 " (.getName file))) + (.setEditable text-area true) + (.setSyntaxEditingStyle text-area + (if (.endsWith (.getName file-to-open) ".clj") + SyntaxConstants/SYNTAX_STYLE_CLOJURE + SyntaxConstants/SYNTAX_STYLE_NONE))) + (do (.setText text-area no-project-txt) + (.setText doc-label (str "Source Editor (No file selected)")) + (.setEditable text-area false))) + (update-caret-position text-area) + (setup-autoindent text-area) + (reset! (app :file) file) + (switch-repl app (first (get-selected-projects app))) + (apply-namespace-to-repl app))) + +(defn save-file [app] + (try + (let [f @(app :file) + ft (File. (str (.getAbsolutePath f) "~"))] + (with-open [writer (BufferedWriter. + (OutputStreamWriter. + (FileOutputStream. f) + "UTF-8"))] + (.write (app :doc-text-area) writer)) + (send-off temp-file-manager (fn [_] 0)) + (.delete ft) + (.updateUI (app :docs-tree))) + (catch Exception e (JOptionPane/showMessageDialog + nil "Unable to save file." + "Oops" JOptionPane/ERROR_MESSAGE)))) + +(def project-clj-text (.trim +" +(defproject PROJECTNAME \"1.0.0-SNAPSHOT\" + :description \"FIXME: write\" + :dependencies [[org.clojure/clojure \"1.3.0\"]]) +")) + +(defn specify-source [project-dir title default-namespace] + (when-let [namespace (JOptionPane/showInputDialog nil + "Please enter a fully-qualified namespace" + title + JOptionPane/QUESTION_MESSAGE + nil + nil + default-namespace)] + (let [tokens (map munge (.split namespace "\\.")) + dirs (cons "src" (butlast tokens)) + dirstring (apply str (interpose File/separator dirs)) + name (last tokens) + the-dir (File. project-dir dirstring)] + (.mkdirs the-dir) + [(File. the-dir (str name ".clj")) namespace]))) + +(defn create-file [app project-dir default-namespace] + (when-let [[file namespace] (specify-source project-dir + "Create a source file" + default-namespace)] + (let [tree (:docs-tree app)] + (spit file (str "(ns " namespace ")\n")) + (update-project-tree (:docs-tree app)) + (set-tree-selection tree (.getAbsolutePath file))))) + +(defn new-project-clj [app project-dir] + (let [project-name (.getName project-dir) + file-text (.replace project-clj-text "PROJECTNAME" project-name)] + (spit (File. project-dir "project.clj") file-text))) + +(defn new-project [app] + (try + (when-let [dir (choose-file (app :frame) "Create a project directory" "" false)] + (awt-event + (let [path (.getAbsolutePath dir)] + (.mkdirs (File. dir "src")) + (new-project-clj app dir) + (add-project app path) + (update-project-tree (:docs-tree app)) + (set-tree-selection (app :docs-tree) path) + (create-file app dir (str (.getName dir) ".core"))))) + (catch Exception e (do (JOptionPane/showMessageDialog nil + "Unable to create project." + "Oops" JOptionPane/ERROR_MESSAGE) + (.printStackTrace e))))) + +(defn rename-file [app] + (when-let [old-file @(app :file)] + (let [tree (app :docs-tree) + [file namespace] (specify-source + (first (get-selected-projects app)) + "Rename a source file" + (get-selected-namespace tree))] + (when file + (.renameTo @(app :file) file) + (update-project-tree (:docs-tree app)) + (awt-event (set-tree-selection tree (.getAbsolutePath file))))))) + +(defn delete-file [app] + (let [path (get-selected-file-path app)] + (when (confirmed? "Are you sure you want to delete this file?\nDeleting cannot be undone." path) + (loop [f (File. path)] + (when (and (empty? (.listFiles f)) + (let [p (-> f .getParentFile .getAbsolutePath)] + (or (.contains p (str File/separator "src" File/separator)) + (.endsWith p (str File/separator "src"))))) + (.delete f) + (recur (.getParentFile f)))) + (update-project-tree (app :docs-tree))))) + +(defn remove-project [app] + (when (confirmed? "Remove the project from list? (No files will be deleted.)" + "Remove project") + (remove-selected-project app))) + +(defn revert-file [app] + (when-let [f @(:file app)] + (let [temp-file (get-temp-file f)] + (when (.exists temp-file)) + (let [path (.getAbsolutePath f)] + (when (confirmed? "Revert the file? This cannot be undone." path) + (.delete temp-file) + (update-project-tree (:docs-tree app)) + (restart-doc app f)))))) + +(defn- dir-rank [dir] + (get {"src" 0 "test" 1 "lib" 2} (.getName dir) 100)) + +(defn- find-file [project-path relative-file-path] + (let [classpath-dirs (sort-by dir-rank < (get-directories (File. project-path))) + file-candidates (map + #(File. (str (.getAbsolutePath %) File/separatorChar relative-file-path)) + classpath-dirs)] + (first (filter #(and (.exists %) (.isFile %)) file-candidates)))) + +(defn goto-definition [ns app] + (let [text-comp (:doc-text-area app) + pos (.getCaretPosition text-comp) + text (.getText text-comp) + src-file (:file (meta (do + (token-from-caret-pos ns text pos) nil))) + line (:line (meta (do (find-ns (symbol ns)) + (token-from-caret-pos ns text pos) nil))) + project-path (first (get-selected-projects app)) + file (find-file project-path src-file)] + (when (and file line) + (when (not= file @(:file app)) + (restart-doc app file) + (set-tree-selection (:docs-tree app) (.getAbsolutePath file))) + (scroll-to-line text-comp line)))) + +(defn make-menus [app] + (when (is-mac) + (System/setProperty "apple.laf.useScreenMenuBar" "true")) + (let [menu-bar (JMenuBar.)] + (. (app :frame) setJMenuBar menu-bar) + (let [file-menu + (add-menu menu-bar "File" "F" + ["New" "N" "cmd1 N" #(create-file app (first (get-selected-projects app)) "")] + ["Save" "S" "cmd1 S" #(save-file app)] + ["Move/Rename" "M" nil #(rename-file app)] + ["Revert" "R" nil #(revert-file app)] + ["Delete" nil nil #(delete-file app)])] + (when-not (is-mac) + (add-menu-item file-menu "Exit" "X" nil #(System/exit 0)))) + (add-menu menu-bar "Project" "P" + ["New..." "N" "cmd1 shift N" #(new-project app)] + ["Open..." "O" "cmd1 shift O" #(open-project app)] + ["Move/Rename" "M" nil #(rename-project app)] + ["Remove" nil nil #(remove-project app)]) + (add-menu menu-bar "Source" "U" + ["Comment-out" "C" "cmd1 SEMICOLON" #(comment-out (:doc-text-area app))] + ["Uncomment-out" "U" "cmd1 shift SEMICOLON" #(uncomment-out (:doc-text-area app))] + ["Fix indentation" "F" "cmd1 BACK_SLASH" #(fix-indent-selected-lines (:doc-text-area app))] + ["Indent lines" "I" "cmd1 CLOSE_BRACKET" #(indent (:doc-text-area app))] + ["Unindent lines" "D" "cmd1 OPEN_BRACKET" #(indent (:doc-text-area app))] + ["Name search/docs" "S" "TAB" #(show-tab-help app (find-focused-text-pane app) inc)] + ;["Go to definition" "G" "cmd1 D" #(goto-definition (get-file-ns app) app)] + ) + (add-menu menu-bar "REPL" "R" + ["Evaluate here" "E" "cmd1 ENTER" #(send-selected-to-repl app)] + ["Evaluate entire file" "F" "cmd1 E" #(send-doc-to-repl app)] + ["Apply file ns" "A" "cmd1 shift A" #(apply-namespace-to-repl app)] + ["Clear output" "C" "cmd1 K" #(.setText (app :repl-out-text-area) "")] + ["Restart" "R" "cmd1 R" #(restart-repl app + (first (get-selected-projects app)))] + ["Print stack trace for last error" "T" "cmd1 T" #(print-stack-trace app)]) + (add-menu menu-bar "Search" "S" + ["Find" "F" "cmd1 F" #(start-find app)] + ["Find next" "N" "cmd1 G" #(highlight-step app false)] + ["Find prev" "P" "cmd1 shift G" #(highlight-step app true)]) + (add-menu menu-bar "Window" "W" + ["Go to REPL input" "R" "cmd1 3" #(.requestFocusInWindow (:repl-in-text-area app))] + ["Go to Editor" "E" "cmd1 2" #(.requestFocusInWindow (:doc-text-area app))] + ["Go to Project Tree" "P" "cmd1 1" #(.requestFocusInWindow (:docs-tree app))] + ["Increase font size" nil "cmd1 PLUS" #(grow-font app)] + ["Decrease font size" nil "cmd1 MINUS" #(shrink-font app)] + ["Choose font..." nil nil #(apply show-font-window + app set-font @current-font)]))) + + +(defn add-visibility-shortcut [app] + (let [shortcuts [(map get-keystroke ["cmd2 EQUALS" "cmd2 PLUS"])]] + (.. Toolkit getDefaultToolkit + (addAWTEventListener + (proxy [AWTEventListener] [] + (eventDispatched [e] + (when (some #{(KeyStroke/getKeyStrokeForEvent e)} + shortcuts) + (.toFront (:frame app))))) + AWTEvent/KEY_EVENT_MASK)))) + +;; startup + + +(defn startup [create-app current-app] + (Thread/setDefaultUncaughtExceptionHandler + (proxy [Thread$UncaughtExceptionHandler] [] + (uncaughtException [thread exception] + (println thread) (.printStackTrace exception)))) + (UIManager/setLookAndFeel (UIManager/getSystemLookAndFeelClassName)) + (let [app (create-app)] + (reset! current-app app) + (make-menus app) + (add-visibility-shortcut app) + (add-repl-input-handler app) + (setup-tab-help app (app :repl-in-text-area)) + (doall (map #(add-project app %) (load-project-set))) + (let [frame (app :frame)] + (persist-window-shape clooj-prefs "main-window" frame) + (.setVisible frame true) + (on-window-activation frame #(update-project-tree (app :docs-tree)))) + (setup-temp-writer app) + (setup-tree app) + (let [tree (app :docs-tree)] + (load-expanded-paths tree) + (load-tree-selection tree)) + (load-font app))) + +;; testing + +(defn get-text [current-app] + (get-text-str (@current-app :doc-text-area))) + diff --git a/src/clooj/project.clj b/src/clooj/project.clj index ef6b5bb..aabaf98 100644 --- a/src/clooj/project.clj +++ b/src/clooj/project.clj @@ -15,7 +15,7 @@ ;; projects tree -(declare restart-doc) +; (declare restart-doc) (def project-set (atom (sorted-set))) From 3dc03b0428e904fcd7c1946cb68a1cff3584aeb9 Mon Sep 17 00:00:00 2001 From: Jon Date: Tue, 29 May 2012 09:15:33 -0700 Subject: [PATCH 06/11] remove uneeded interop functions which are now handled by seesaw --- src/clooj/dev_tools.clj | 22 +++------------------- src/clooj/help.clj | 5 +++-- 2 files changed, 6 insertions(+), 21 deletions(-) diff --git a/src/clooj/dev_tools.clj b/src/clooj/dev_tools.clj index df1f961..c0ff50d 100644 --- a/src/clooj/dev_tools.clj +++ b/src/clooj/dev_tools.clj @@ -311,12 +311,6 @@ ;; build gui -; (defn make-tabbed-pane [text-area label] -; (tabbed-panel :placement :top :tabs [{:title label :content text-area}])) - -(defn make-scroll-pane [text-area] - (RTextScrollPane. text-area)) - (defn setup-search-text-area [app] (let [sta (doto (app :search-text-area) (.setVisible false) @@ -327,18 +321,6 @@ ["shift ENTER" #(highlight-step app true)] ["ESCAPE" #(escape-find app)]))) -(defn create-arglist-label [] - (doto (JLabel.) - (.setVisible true) - )) - -(defn exit-if-closed [^java.awt.Window f] - (when-not @embedded - (.addWindowListener f - (proxy [WindowAdapter] [] - (windowClosing [_] - (System/exit 0)))))) - (def no-project-txt "\n Welcome to clooj, a lightweight IDE for clojure\n To start coding, you can either\n @@ -608,7 +590,9 @@ ["Increase font size" nil "cmd1 PLUS" #(grow-font app)] ["Decrease font size" nil "cmd1 MINUS" #(shrink-font app)] ["Choose font..." nil nil #(apply show-font-window - app set-font @current-font)]))) + app set-font @current-font)]) + (when (is-mac) (add-menu menu-bar "Help" "H")) + )) (defn add-visibility-shortcut [app] diff --git a/src/clooj/help.clj b/src/clooj/help.clj index 2b55e4f..f23240a 100644 --- a/src/clooj/help.clj +++ b/src/clooj/help.clj @@ -280,7 +280,7 @@ (app :help-text-scroll-pane)) (set-first-component (app :doc-split-pane) (app :completion-panel)) - (.setText (app :repl-label) "Documentation") + ; (.setText (app :repl-label) "Documentation") (.ensureIndexIsVisible help-list (.getSelectedIndex help-list))))) @@ -317,7 +317,8 @@ (app :repl-out-scroll-pane)) (set-first-component (app :doc-split-pane) (app :docs-tree-panel)) - (.setText (app :repl-label) "Clojure REPL output")) + ; (.setText (app :repl-label) "Clojure REPL output") + ) (swap! help-state assoc :visible false :pos nil))) (defn help-handle-caret-move [app text-comp] From f378781acede56fa4f90b56b45cbc9e7cb1f26e7 Mon Sep 17 00:00:00 2001 From: Jon Date: Tue, 29 May 2012 09:49:36 -0700 Subject: [PATCH 07/11] pull text editor component out of create-app and make a creation function --- src/clooj/core.clj | 183 ++++++++++++++++++++++++++------------------- 1 file changed, 108 insertions(+), 75 deletions(-) diff --git a/src/clooj/core.clj b/src/clooj/core.clj index 26b9e90..5ddbe19 100644 --- a/src/clooj/core.clj +++ b/src/clooj/core.clj @@ -4,7 +4,7 @@ ; arthuredelstein@gmail.com (ns clooj.core - (:use [seesaw core graphics color] + (:use [seesaw core graphics color border] [clojure.pprint :only (pprint)] [clooj.dev-tools] [clooj.brackets] @@ -17,7 +17,7 @@ [clooj.indent] [clooj.style] [clooj.navigate]) - (:import (javax.swing AbstractListModel BorderFactory JDialog + (:import (javax.swing AbstractListModel BorderFactory JDialog JFrame JLabel JList JMenuBar JOptionPane JPanel JScrollPane JSplitPane JTextArea JTextField JTree KeyStroke SpringLayout JTextPane @@ -36,36 +36,93 @@ (java.io File FileReader StringReader BufferedWriter OutputStreamWriter FileOutputStream) (org.fife.ui.rsyntaxtextarea RSyntaxTextArea SyntaxConstants TokenMakerFactory) - (org.fife.ui.rtextarea RTextScrollPane))) + (org.fife.ui.rtextarea RTextScrollPane)) + (:require [clooj.rsyntax :as rsyntax])) + +(native!) + +(defn make-text-editor-comp + [app] + (let [arglist-label (label :foreground (color :blue) + :id :arglist-label + :class :arg-response) + search-text-area (text :id :search-text-area + :class :search-area) + arg-search-panel (horizontal-panel + :items [arglist-label search-text-area] + :id :arg-search-panel + :class :search-panel) + pos-label (label :id :pos-label + :class :pos-label) + position-search-panel (horizontal-panel + :items [pos-label + [:fill-h 10] + arg-search-panel + :fill-h] + :maximum-size [2000 :by 15] + :id :position-search-panel + :class :search-panel) + doc-label (label :text "Source Editor" + :id :doc-label + :class :text-editor-comp) + doc-text-area (rsyntax/text-area + :wrap-lines? false + :id :doc-text-area + :class :text-editor-comp) + doc-scroll-pane (scrollable doc-text-area + :id :doc-scroll-pane + :class :text-editor-comp) + doc-text-panel (vertical-panel + :items [doc-label + doc-scroll-pane + position-search-panel] + :id :doc-text-panel + :class :text-editor-comp)] + [doc-text-panel + (merge + app + (gen-map + arglist-label + search-text-area + arg-search-panel + pos-label + position-search-panel + doc-label + doc-text-area + doc-scroll-pane + doc-text-panel))])) + +; (defn make-doc-tree-comp +; [app] +; (let [docs-tree (tree :model (DefaultTreeModel. nil)) +; docs-tree-scroll-pane (scrollable docs-tree) +; docs-tree-label (border-panel +; :west (label "Projects") +; :size [200 :by 15] +; :vgap 5) +; docs-tree-panel (vertical-panel +; :items [docs-tree-label +; docs-tree-scroll-pane])])) (defn create-app [] (let [ - arglist-label (label) - - search-text-area (text :size [200 :by 12]) - pos-label (label :font (font "COURIER" 13)) - position-search-panel (border-panel - :west pos-label - :center search-text-area - :hgap 15) - - doc-label (label "Source Editor") - doc-text-area (make-text-area false) - doc-scroll-pane (make-scroll-pane doc-text-area) - doc-text-panel (vertical-panel :items [doc-label doc-scroll-pane position-search-panel]) - - help-text-area (make-text-area true) - help-text-scroll-pane (scrollable help-text-area) + app-init (second (-> {} make-text-editor-comp)) + + help-text-area (rsyntax/text-area :wrap-lines? true + :editable? false + :background (color 0xFF 0xFF 0xE8) + :border (compound-border "Documentation")) + help-text-scroll-pane (scrollable help-text-area) completion-label (label "Name search") - completion-list (listbox ) + + completion-list (listbox :border (compound-border "Doc List")) + completion-scroll-pane (scrollable completion-list) completion-panel (vertical-panel :items [completion-label completion-scroll-pane]) - cp (:content-pane frame) - - docs-tree (tree) + docs-tree (tree :model (DefaultTreeModel. nil)) docs-tree-scroll-pane (scrollable docs-tree) docs-tree-label (border-panel :west (label "Projects") @@ -74,31 +131,37 @@ docs-tree-panel (vertical-panel :items [docs-tree-label docs-tree-scroll-pane]) - doc-split-pane (left-right-split docs-tree-panel - doc-text-panel - :divider-location 0.2) + (app-init :doc-text-panel) + :divider-location 0.25 + :resize-weight 0.25 + :divider-size 5) - repl-out-text-area (make-text-area false) + + repl-out-text-area (rsyntax/text-area :wrap-lines? false + :editable? false + :id :repl-out-text-area + :class :repl) repl-out-writer (make-repl-writer repl-out-text-area) - repl-out-scroll-pane (scrollable repl-out-text-area) repl-output-vertical-panel (vertical-panel :items [repl-out-scroll-pane]) - - repl-in-text-area (make-text-area false) + repl-in-text-area (rsyntax/text-area :wrap-lines? false + :syntax "clojure") repl-input-vertical-panel (vertical-panel :items [repl-in-text-area]) - repl-split-pane (top-bottom-split repl-output-vertical-panel repl-input-vertical-panel - :divider-location 0.7) - - split-pane (top-bottom-split + :divider-location 0.66 + :divider-size 5) + + + split-pane (left-right-split doc-split-pane repl-split-pane - :divider-location 0.7) - + :divider-location 0.66 + :resize-weight 0.66 + :divider-size 5) frame (frame :title "Overtone sketch" :width 950 @@ -110,10 +173,9 @@ app (merge {:file (atom nil) :repl (atom (create-outside-repl repl-out-writer nil)) :changed false} + app-init (gen-map - doc-text-area - doc-label - repl-out-text-area +repl-out-text-area repl-in-text-area frame help-text-area @@ -123,62 +185,33 @@ docs-tree-scroll-pane docs-tree-panel docs-tree-label - search-text-area - pos-label repl-out-writer doc-split-pane repl-split-pane split-pane - arglist-label completion-list completion-scroll-pane completion-panel))] - - - (doto doc-text-area + (doto (app :doc-text-area) attach-navigation-keys) - (setup-completion-list completion-list app) - - - (double-click-selector doc-text-area) - + (double-click-selector (app :doc-text-area)) (doto repl-in-text-area double-click-selector attach-navigation-keys) - - (.setSyntaxEditingStyle repl-in-text-area - SyntaxConstants/SYNTAX_STYLE_CLOJURE) - - (.setModel docs-tree (DefaultTreeModel. nil)) - - ; (exit-if-closed frame) - (setup-search-text-area app) - - (add-caret-listener doc-text-area #(display-caret-position app)) - + (add-caret-listener (app :doc-text-area) #(display-caret-position app)) (activate-caret-highlighter app) - (setup-temp-writer app) - - (attach-action-keys doc-text-area + (attach-action-keys (app :doc-text-area) ["cmd1 ENTER" #(send-selected-to-repl app)]) - - (doto repl-out-text-area (.setEditable false)) - - (doto help-text-area (.setEditable false) - (.setBackground (color 0xFF 0xFF 0xE8))) - (setup-autoindent repl-in-text-area) - - (setup-tab-help app doc-text-area) - + (setup-tab-help app (app :doc-text-area)) (dorun (map #(attach-global-action-keys % app) - [docs-tree doc-text-area repl-in-text-area repl-out-text-area (.getContentPane frame)])) + [docs-tree (app :doc-text-area) repl-in-text-area repl-out-text-area (.getContentPane frame)])) - (setup-autoindent doc-text-area) + (setup-autoindent (app :doc-text-area)) app)) (defonce current-app (atom nil)) From ae57b968fc1ac6a0c30ef9cedb034f4931eb7fa2 Mon Sep 17 00:00:00 2001 From: Jon Date: Tue, 29 May 2012 12:14:20 -0700 Subject: [PATCH 08/11] pulled all components out into serperate functions and components --- project.clj | 2 +- src/clooj/core.clj | 327 ++++++++++++++++++++++------------------ src/clooj/dev_tools.clj | 5 +- src/clooj/help.clj | 1 + 4 files changed, 183 insertions(+), 152 deletions(-) diff --git a/project.clj b/project.clj index 2473889..e445bca 100644 --- a/project.clj +++ b/project.clj @@ -6,4 +6,4 @@ [slamhound "1.2.0"] [com.cemerick/pomegranate "0.0.11"] [com.fifesoft/rsyntaxtextarea "2.0.2"] - [seesaw "1.4.0"]]) + [seesaw "1.4.1"]]) diff --git a/src/clooj/core.clj b/src/clooj/core.clj index 5ddbe19..ed9f21b 100644 --- a/src/clooj/core.clj +++ b/src/clooj/core.clj @@ -5,44 +5,28 @@ (ns clooj.core (:use [seesaw core graphics color border] - [clojure.pprint :only (pprint)] - [clooj.dev-tools] - [clooj.brackets] - [clooj.highlighting] - [clooj.repl] - [clooj.search] - [clooj.help] - [clooj.project] - [clooj.utils] - [clooj.indent] - [clooj.style] - [clooj.navigate]) - (:import (javax.swing AbstractListModel BorderFactory JDialog - JFrame JLabel JList JMenuBar JOptionPane - JPanel JScrollPane JSplitPane JTextArea - JTextField JTree KeyStroke SpringLayout JTextPane - ListSelectionModel - UIManager) + [clojure.pprint :only (pprint)] + [clooj.dev-tools] + [clooj.brackets] + [clooj.highlighting] + [clooj.repl] + [clooj.search] + [clooj.help] + [clooj.project] + [clooj.utils] + [clooj.indent] + [clooj.style] + [clooj.navigate]) + (:import (javax.swing.event TreeSelectionListener TreeExpansionListener) (javax.swing.tree DefaultMutableTreeNode DefaultTreeModel - TreePath TreeSelectionModel) - (java.awt Insets Rectangle Window) - (java.awt.event AWTEventListener FocusAdapter MouseAdapter - WindowAdapter KeyAdapter) - (java.awt AWTEvent Color Font GridLayout Toolkit) - (java.net URL) - (java.util Map) - (java.io File FileReader StringReader - BufferedWriter OutputStreamWriter FileOutputStream) - (org.fife.ui.rsyntaxtextarea RSyntaxTextArea SyntaxConstants TokenMakerFactory) - (org.fife.ui.rtextarea RTextScrollPane)) + TreePath TreeSelectionModel)) (:require [clooj.rsyntax :as rsyntax])) -(native!) (defn make-text-editor-comp - [app] + [app-atom] (let [arglist-label (label :foreground (color :blue) :id :arglist-label :class :arg-response) @@ -70,7 +54,7 @@ :id :doc-text-area :class :text-editor-comp) doc-scroll-pane (scrollable doc-text-area - :id :doc-scroll-pane + :id :doc-scrollable :class :text-editor-comp) doc-text-panel (vertical-panel :items [doc-label @@ -78,140 +62,189 @@ position-search-panel] :id :doc-text-panel :class :text-editor-comp)] - [doc-text-panel - (merge - app - (gen-map - arglist-label - search-text-area - arg-search-panel - pos-label - position-search-panel - doc-label - doc-text-area - doc-scroll-pane - doc-text-panel))])) - -; (defn make-doc-tree-comp -; [app] -; (let [docs-tree (tree :model (DefaultTreeModel. nil)) -; docs-tree-scroll-pane (scrollable docs-tree) -; docs-tree-label (border-panel -; :west (label "Projects") -; :size [200 :by 15] -; :vgap 5) -; docs-tree-panel (vertical-panel -; :items [docs-tree-label -; docs-tree-scroll-pane])])) + (swap! app-atom conj (gen-map + arglist-label + search-text-area + arg-search-panel + pos-label + position-search-panel + doc-label + doc-text-area + doc-scroll-pane + doc-text-panel)) + doc-text-panel)) + +(defn make-file-tree-comp + [app-atom] + (let [docs-tree (tree :model (DefaultTreeModel. nil) + :id :file-tree + :class :file-tree) + docs-tree-scroll-pane (scrollable docs-tree + :id :file-tree-scrollable + :class :file-tree) + docs-tree-label (border-panel + :west (label "Projects") + :size [200 :by 15] + :vgap 5 + :id :file-tree-label + :class :file-tree) + docs-tree-panel (vertical-panel + :items [docs-tree-label + docs-tree-scroll-pane] + :id :file-tree-panel + :class :file-tree)] + (swap! app-atom conj (gen-map + docs-tree + docs-tree-scroll-pane + docs-tree-label + docs-tree-panel)) + docs-tree-panel)) +(defn make-repl-comp + [app-atom] + (let [repl-out-text-area (rsyntax/text-area + :wrap-lines? false + :editable? false + :id :repl-out-text-area + :class :repl) + repl-out-writer (make-repl-writer repl-out-text-area) + repl-out-scroll-pane (scrollable repl-out-text-area + :id :repl-out-scrollable + :class :repl) + repl-output-vertical-panel (vertical-panel + :items [repl-out-scroll-pane] + :id :repl-output-vertical-panel + :class :repl) + repl-in-text-area (rsyntax/text-area + :wrap-lines? false + :syntax "clojure" + :id :repl-in-text-area + :class :repl) + repl-input-vertical-panel (vertical-panel + :items [repl-in-text-area] + :id :repl-input-vertical-panel + :class :repl) + repl-split-pane (top-bottom-split repl-output-vertical-panel + repl-input-vertical-panel + :divider-location 0.66 + :divider-size 5)] + (swap! app-atom conj (gen-map + repl-out-scroll-pane + repl-out-text-area + repl-in-text-area + repl-input-vertical-panel + repl-out-writer + repl-split-pane)) + repl-split-pane)) +(defn make-doc-nav-comp + [app-atom] + (let [completion-label (label :text "Name search" + :id :doc-nav-label + :class :doc-nav-comp) + completion-list (listbox :border (compound-border "Doc List") + :id :doc-nav-list + :class :doc-nav-comp) + completion-scroll-pane (scrollable completion-list + :id :doc-nav-scrollable + :class :doc-nav-comp) + completion-panel (vertical-panel + :items [completion-label + completion-scroll-pane] + :id :doc-nav-panel + :class :doc-nav-comp)] + (swap! app-atom conj (gen-map + completion-label + completion-list + completion-scroll-pane + completion-panel)) + + completion-panel)) + +(defn make-doc-view-comp + [app-atom] + (let [help-text-area (rsyntax/text-area + :wrap-lines? true + :editable? false + :background (color 0xFF 0xFF 0xE8) + :border (compound-border "Documentation") + :id :doc-view-text-area + :class :doc-view-comp) + help-text-scroll-pane (scrollable help-text-area + :id :doc-view-scrollable + :class :doc-view-comp)] + (swap! app-atom conj (gen-map + help-text-area + help-text-scroll-pane)) + help-text-scroll-pane)) + +(defn add-behaviors + [app] + ;; docs + (setup-completion-list (app :completion-list) app) + (setup-tab-help app (app :doc-text-area)) + ;;editor + (setup-autoindent (app :doc-text-area)) + (doto (app :doc-text-area) attach-navigation-keys) + (double-click-selector (app :doc-text-area)) + (add-caret-listener (app :doc-text-area) #(display-caret-position app)) + (setup-search-text-area app) + (activate-caret-highlighter app) + (setup-temp-writer app) + (attach-action-keys (app :doc-text-area) + ["cmd1 ENTER" #(send-selected-to-repl app)]) + ;; repl + (setup-autoindent (app :repl-in-text-area)) + (doto (app :repl-in-text-area) + double-click-selector + attach-navigation-keys) + ;; global + (dorun (map #(attach-global-action-keys % app) + [(app :docs-tree) + (app :doc-text-area) + (app :repl-in-text-area) + (app :repl-out-text-area) + (.getContentPane (app :frame))]))) + (defn create-app [] - (let [ - app-init (second (-> {} make-text-editor-comp)) - - - help-text-area (rsyntax/text-area :wrap-lines? true - :editable? false - :background (color 0xFF 0xFF 0xE8) - :border (compound-border "Documentation")) - help-text-scroll-pane (scrollable help-text-area) - completion-label (label "Name search") - - completion-list (listbox :border (compound-border "Doc List")) - - completion-scroll-pane (scrollable completion-list) - completion-panel (vertical-panel :items [completion-label completion-scroll-pane]) - - docs-tree (tree :model (DefaultTreeModel. nil)) - docs-tree-scroll-pane (scrollable docs-tree) - docs-tree-label (border-panel - :west (label "Projects") - :size [200 :by 15] - :vgap 5) - docs-tree-panel (vertical-panel - :items [docs-tree-label - docs-tree-scroll-pane]) + (let [app-init (atom {}) + + editor (make-text-editor-comp app-init) + file-tree (make-file-tree-comp app-init) + repl (make-repl-comp app-init) + + doc-view (make-doc-view-comp app-init) + doc-nav (make-doc-nav-comp app-init) + doc-split-pane (left-right-split - docs-tree-panel - (app-init :doc-text-panel) + file-tree + editor :divider-location 0.25 :resize-weight 0.25 :divider-size 5) - - - repl-out-text-area (rsyntax/text-area :wrap-lines? false - :editable? false - :id :repl-out-text-area - :class :repl) - repl-out-writer (make-repl-writer repl-out-text-area) - repl-out-scroll-pane (scrollable repl-out-text-area) - repl-output-vertical-panel (vertical-panel :items [repl-out-scroll-pane]) - repl-in-text-area (rsyntax/text-area :wrap-lines? false - :syntax "clojure") - repl-input-vertical-panel (vertical-panel :items [repl-in-text-area]) - repl-split-pane (top-bottom-split - repl-output-vertical-panel - repl-input-vertical-panel - :divider-location 0.66 - :divider-size 5) - - split-pane (left-right-split doc-split-pane - repl-split-pane + repl :divider-location 0.66 :resize-weight 0.66 :divider-size 5) frame (frame - :title "Overtone sketch" + :title "Clooj" :width 950 :height 700 :on-close :exit :minimum-size [500 :by 350] :content split-pane) - app (merge {:file (atom nil) - :repl (atom (create-outside-repl repl-out-writer nil)) - :changed false} - app-init - (gen-map -repl-out-text-area - repl-in-text-area - frame - help-text-area - help-text-scroll-pane - repl-out-scroll-pane - docs-tree - docs-tree-scroll-pane - docs-tree-panel - docs-tree-label - repl-out-writer - doc-split-pane - repl-split-pane - split-pane - completion-list - completion-scroll-pane - completion-panel))] - - (doto (app :doc-text-area) - attach-navigation-keys) - (setup-completion-list completion-list app) - (double-click-selector (app :doc-text-area)) - (doto repl-in-text-area - double-click-selector - attach-navigation-keys) - (setup-search-text-area app) - (add-caret-listener (app :doc-text-area) #(display-caret-position app)) - (activate-caret-highlighter app) - (setup-temp-writer app) - (attach-action-keys (app :doc-text-area) - ["cmd1 ENTER" #(send-selected-to-repl app)]) - (setup-autoindent repl-in-text-area) - (setup-tab-help app (app :doc-text-area)) - (dorun (map #(attach-global-action-keys % app) - [docs-tree (app :doc-text-area) repl-in-text-area repl-out-text-area (.getContentPane frame)])) - - (setup-autoindent (app :doc-text-area)) + app (merge {:file (atom nil) + :repl (atom (create-outside-repl (@app-init :repl-out-writer) nil)) + :changed false} + @app-init + (gen-map + frame + doc-split-pane + split-pane))] + (add-behaviors app) app)) (defonce current-app (atom nil)) diff --git a/src/clooj/dev_tools.clj b/src/clooj/dev_tools.clj index c0ff50d..27f7a47 100644 --- a/src/clooj/dev_tools.clj +++ b/src/clooj/dev_tools.clj @@ -70,6 +70,7 @@ (:gen-class :methods [^{:static true} [show [] void]])) +(native!) (def gap 5) @@ -607,14 +608,11 @@ AWTEvent/KEY_EVENT_MASK)))) ;; startup - - (defn startup [create-app current-app] (Thread/setDefaultUncaughtExceptionHandler (proxy [Thread$UncaughtExceptionHandler] [] (uncaughtException [thread exception] (println thread) (.printStackTrace exception)))) - (UIManager/setLookAndFeel (UIManager/getSystemLookAndFeelClassName)) (let [app (create-app)] (reset! current-app app) (make-menus app) @@ -634,7 +632,6 @@ (load-font app))) ;; testing - (defn get-text [current-app] (get-text-str (@current-app :doc-text-area))) diff --git a/src/clooj/help.clj b/src/clooj/help.clj index f23240a..2e21821 100644 --- a/src/clooj/help.clj +++ b/src/clooj/help.clj @@ -109,6 +109,7 @@ (defn current-ns-form [app] (-> app :doc-text-area .getText read-string)) + (defn ns-available-names [app] (parse-ns-form (current-ns-form app))) From 3c4665a20efe18cc512f71f60581ed7bc7eaa95d Mon Sep 17 00:00:00 2001 From: Jon Date: Tue, 29 May 2012 14:20:44 -0700 Subject: [PATCH 09/11] finish seperating components in core.clj and update main to seesaw style --- project.clj | 10 ++- src/clooj/brackets.clj | 7 ++- src/clooj/core.clj | 16 ++++- src/clooj/dev_tools.clj | 134 +++++++++++++++++++--------------------- 4 files changed, 92 insertions(+), 75 deletions(-) diff --git a/project.clj b/project.clj index e445bca..52a74cc 100644 --- a/project.clj +++ b/project.clj @@ -6,4 +6,12 @@ [slamhound "1.2.0"] [com.cemerick/pomegranate "0.0.11"] [com.fifesoft/rsyntaxtextarea "2.0.2"] - [seesaw "1.4.1"]]) + [seesaw "1.4.1"]] + :jvm-opts ~(if (= (System/getProperty "os.name") "Mac OS X") ["-Xdock:name=Clooj"] []) + :java-source-paths ["src"] + :java-source-path "src" + ;; Use this for Leiningen version 1 + :resources-path "resource" + ;; Use this for Leiningen version 2 + :resource-paths ["resource"] + ) diff --git a/src/clooj/brackets.clj b/src/clooj/brackets.clj index 6890034..999ccc9 100644 --- a/src/clooj/brackets.clj +++ b/src/clooj/brackets.clj @@ -6,7 +6,12 @@ (ns clooj.brackets (:import (javax.swing.text JTextComponent)) (:require [clojure.string :as string]) - (:use [clooj.utils :only (count-while get-text-str)])) + (:use [clooj.utils :only (count-while get-text-str)] + [seesaw.core :only (native!)])) + +;; as seesaw docs instruct, native! is called before any other seesaw calls +(native!) + (defn mismatched-brackets [a b] (and (or (nil? a) (some #{a} [\( \[ \{])) diff --git a/src/clooj/core.clj b/src/clooj/core.clj index ed9f21b..eaefd14 100644 --- a/src/clooj/core.clj +++ b/src/clooj/core.clj @@ -127,7 +127,8 @@ repl-split-pane (top-bottom-split repl-output-vertical-panel repl-input-vertical-panel :divider-location 0.66 - :divider-size 5)] + :resize-weight 0.66 + :divider-size 3)] (swap! app-atom conj (gen-map repl-out-scroll-pane repl-out-text-area @@ -195,6 +196,7 @@ ["cmd1 ENTER" #(send-selected-to-repl app)]) ;; repl (setup-autoindent (app :repl-in-text-area)) + (setup-tab-help app (app :repl-in-text-area)) (doto (app :repl-in-text-area) double-click-selector attach-navigation-keys) @@ -204,7 +206,9 @@ (app :doc-text-area) (app :repl-in-text-area) (app :repl-out-text-area) - (.getContentPane (app :frame))]))) + (.getContentPane (app :frame))])) + ;; frame + ) (defn create-app [] (let [app-init (atom {}) @@ -257,7 +261,13 @@ (defn -main [& args] (reset! embedded false) - (startup create-app current-app)) + (reset! current-app (create-app)) + (add-behaviors @current-app) + (invoke-later + (-> + (startup @current-app) + show!))) + diff --git a/src/clooj/dev_tools.clj b/src/clooj/dev_tools.clj index 27f7a47..a76aeb4 100644 --- a/src/clooj/dev_tools.clj +++ b/src/clooj/dev_tools.clj @@ -70,8 +70,6 @@ (:gen-class :methods [^{:static true} [show [] void]])) -(native!) - (def gap 5) (def embedded (atom false)) @@ -545,56 +543,55 @@ (scroll-to-line text-comp line)))) (defn make-menus [app] - (when (is-mac) - (System/setProperty "apple.laf.useScreenMenuBar" "true")) - (let [menu-bar (JMenuBar.)] - (. (app :frame) setJMenuBar menu-bar) - (let [file-menu - (add-menu menu-bar "File" "F" - ["New" "N" "cmd1 N" #(create-file app (first (get-selected-projects app)) "")] - ["Save" "S" "cmd1 S" #(save-file app)] - ["Move/Rename" "M" nil #(rename-file app)] - ["Revert" "R" nil #(revert-file app)] - ["Delete" nil nil #(delete-file app)])] - (when-not (is-mac) - (add-menu-item file-menu "Exit" "X" nil #(System/exit 0)))) - (add-menu menu-bar "Project" "P" - ["New..." "N" "cmd1 shift N" #(new-project app)] - ["Open..." "O" "cmd1 shift O" #(open-project app)] - ["Move/Rename" "M" nil #(rename-project app)] - ["Remove" nil nil #(remove-project app)]) - (add-menu menu-bar "Source" "U" - ["Comment-out" "C" "cmd1 SEMICOLON" #(comment-out (:doc-text-area app))] - ["Uncomment-out" "U" "cmd1 shift SEMICOLON" #(uncomment-out (:doc-text-area app))] - ["Fix indentation" "F" "cmd1 BACK_SLASH" #(fix-indent-selected-lines (:doc-text-area app))] - ["Indent lines" "I" "cmd1 CLOSE_BRACKET" #(indent (:doc-text-area app))] - ["Unindent lines" "D" "cmd1 OPEN_BRACKET" #(indent (:doc-text-area app))] - ["Name search/docs" "S" "TAB" #(show-tab-help app (find-focused-text-pane app) inc)] - ;["Go to definition" "G" "cmd1 D" #(goto-definition (get-file-ns app) app)] - ) - (add-menu menu-bar "REPL" "R" - ["Evaluate here" "E" "cmd1 ENTER" #(send-selected-to-repl app)] - ["Evaluate entire file" "F" "cmd1 E" #(send-doc-to-repl app)] - ["Apply file ns" "A" "cmd1 shift A" #(apply-namespace-to-repl app)] - ["Clear output" "C" "cmd1 K" #(.setText (app :repl-out-text-area) "")] - ["Restart" "R" "cmd1 R" #(restart-repl app - (first (get-selected-projects app)))] - ["Print stack trace for last error" "T" "cmd1 T" #(print-stack-trace app)]) - (add-menu menu-bar "Search" "S" - ["Find" "F" "cmd1 F" #(start-find app)] - ["Find next" "N" "cmd1 G" #(highlight-step app false)] - ["Find prev" "P" "cmd1 shift G" #(highlight-step app true)]) - (add-menu menu-bar "Window" "W" - ["Go to REPL input" "R" "cmd1 3" #(.requestFocusInWindow (:repl-in-text-area app))] - ["Go to Editor" "E" "cmd1 2" #(.requestFocusInWindow (:doc-text-area app))] - ["Go to Project Tree" "P" "cmd1 1" #(.requestFocusInWindow (:docs-tree app))] - ["Increase font size" nil "cmd1 PLUS" #(grow-font app)] - ["Decrease font size" nil "cmd1 MINUS" #(shrink-font app)] - ["Choose font..." nil nil #(apply show-font-window - app set-font @current-font)]) - (when (is-mac) (add-menu menu-bar "Help" "H")) - )) - + (when-not (contains? app :menus) + (when (is-mac) + (System/setProperty "apple.laf.useScreenMenuBar" "true")) + (let [menu-bar (JMenuBar.)] + (. (app :frame) setJMenuBar menu-bar) + (let [file-menu + (add-menu menu-bar "File" "F" + ["New" "N" "cmd1 N" #(create-file app (first (get-selected-projects app)) "")] + ["Save" "S" "cmd1 S" #(save-file app)] + ["Move/Rename" "M" nil #(rename-file app)] + ["Revert" "R" nil #(revert-file app)] + ["Delete" nil nil #(delete-file app)])] + (when-not (is-mac) + (add-menu-item file-menu "Exit" "X" nil #(System/exit 0)))) + (add-menu menu-bar "Project" "P" + ["New..." "N" "cmd1 shift N" #(new-project app)] + ["Open..." "O" "cmd1 shift O" #(open-project app)] + ["Move/Rename" "M" nil #(rename-project app)] + ["Remove" nil nil #(remove-project app)]) + (add-menu menu-bar "Source" "U" + ["Comment-out" "C" "cmd1 SEMICOLON" #(comment-out (:doc-text-area app))] + ["Uncomment-out" "U" "cmd1 shift SEMICOLON" #(uncomment-out (:doc-text-area app))] + ["Fix indentation" "F" "cmd1 BACK_SLASH" #(fix-indent-selected-lines (:doc-text-area app))] + ["Indent lines" "I" "cmd1 CLOSE_BRACKET" #(indent (:doc-text-area app))] + ["Unindent lines" "D" "cmd1 OPEN_BRACKET" #(indent (:doc-text-area app))] + ["Name search/docs" "S" "TAB" #(show-tab-help app (find-focused-text-pane app) inc)] + ;["Go to definition" "G" "cmd1 D" #(goto-definition (get-file-ns app) app)] + ) + (add-menu menu-bar "REPL" "R" + ["Evaluate here" "E" "cmd1 ENTER" #(send-selected-to-repl app)] + ["Evaluate entire file" "F" "cmd1 E" #(send-doc-to-repl app)] + ["Apply file ns" "A" "cmd1 shift A" #(apply-namespace-to-repl app)] + ["Clear output" "C" "cmd1 K" #(.setText (app :repl-out-text-area) "")] + ["Restart" "R" "cmd1 R" #(restart-repl app + (first (get-selected-projects app)))] + ["Print stack trace for last error" "T" "cmd1 T" #(print-stack-trace app)]) + (add-menu menu-bar "Search" "S" + ["Find" "F" "cmd1 F" #(start-find app)] + ["Find next" "N" "cmd1 G" #(highlight-step app false)] + ["Find prev" "P" "cmd1 shift G" #(highlight-step app true)]) + (add-menu menu-bar "Window" "W" + ["Go to REPL input" "R" "cmd1 3" #(.requestFocusInWindow (:repl-in-text-area app))] + ["Go to Editor" "E" "cmd1 2" #(.requestFocusInWindow (:doc-text-area app))] + ["Go to Project Tree" "P" "cmd1 1" #(.requestFocusInWindow (:docs-tree app))] + ["Increase font size" nil "cmd1 PLUS" #(grow-font app)] + ["Decrease font size" nil "cmd1 MINUS" #(shrink-font app)] + ["Choose font..." nil nil #(apply show-font-window + app set-font @current-font)]) + (when (is-mac) (add-menu menu-bar "Help" "H"))))) (defn add-visibility-shortcut [app] (let [shortcuts [(map get-keystroke ["cmd2 EQUALS" "cmd2 PLUS"])]] @@ -608,28 +605,25 @@ AWTEvent/KEY_EVENT_MASK)))) ;; startup -(defn startup [create-app current-app] +(defn startup [app] (Thread/setDefaultUncaughtExceptionHandler (proxy [Thread$UncaughtExceptionHandler] [] (uncaughtException [thread exception] (println thread) (.printStackTrace exception)))) - (let [app (create-app)] - (reset! current-app app) - (make-menus app) - (add-visibility-shortcut app) - (add-repl-input-handler app) - (setup-tab-help app (app :repl-in-text-area)) - (doall (map #(add-project app %) (load-project-set))) - (let [frame (app :frame)] - (persist-window-shape clooj-prefs "main-window" frame) - (.setVisible frame true) - (on-window-activation frame #(update-project-tree (app :docs-tree)))) - (setup-temp-writer app) - (setup-tree app) - (let [tree (app :docs-tree)] - (load-expanded-paths tree) - (load-tree-selection tree)) - (load-font app))) + (add-visibility-shortcut app) + (make-menus app) + (add-repl-input-handler app) + (doall (map #(add-project app %) (load-project-set))) + (let [frame (app :frame)] + (persist-window-shape clooj-prefs "main-window" frame) + (on-window-activation frame #(update-project-tree (app :docs-tree)))) + (setup-temp-writer app) + (load-font app) + (setup-tree app) + (let [tree (app :docs-tree)] + (load-expanded-paths tree) + (load-tree-selection tree)) + (app :frame)) ;; testing (defn get-text [current-app] From e9fc56c66dcf6d441a7ec0132fcc683e74c773ec Mon Sep 17 00:00:00 2001 From: Jon Date: Tue, 29 May 2012 14:25:29 -0700 Subject: [PATCH 10/11] remove extra call to add-behaviors in create-app --- src/clooj/core.clj | 1 - 1 file changed, 1 deletion(-) diff --git a/src/clooj/core.clj b/src/clooj/core.clj index eaefd14..36f5e92 100644 --- a/src/clooj/core.clj +++ b/src/clooj/core.clj @@ -248,7 +248,6 @@ frame doc-split-pane split-pane))] - (add-behaviors app) app)) (defonce current-app (atom nil)) From f406669ef4aea411ebdca55529d11f2136cb9d15 Mon Sep 17 00:00:00 2001 From: Jon Date: Tue, 29 May 2012 16:00:36 -0700 Subject: [PATCH 11/11] move add-behaviors to after create-app and remove make- prefix and comp from init function names --- src/clooj/core.clj | 88 +++++++++++++++++++---------------------- src/clooj/dev_tools.clj | 3 +- src/clooj/help.clj | 2 +- 3 files changed, 43 insertions(+), 50 deletions(-) diff --git a/src/clooj/core.clj b/src/clooj/core.clj index 36f5e92..08206f3 100644 --- a/src/clooj/core.clj +++ b/src/clooj/core.clj @@ -25,7 +25,7 @@ (:require [clooj.rsyntax :as rsyntax])) -(defn make-text-editor-comp +(defn text-editor [app-atom] (let [arglist-label (label :foreground (color :blue) :id :arglist-label @@ -74,7 +74,7 @@ doc-text-panel)) doc-text-panel)) -(defn make-file-tree-comp +(defn file-tree [app-atom] (let [docs-tree (tree :model (DefaultTreeModel. nil) :id :file-tree @@ -98,9 +98,9 @@ docs-tree-scroll-pane docs-tree-label docs-tree-panel)) - docs-tree-panel)) + docs-tree-panel)) -(defn make-repl-comp +(defn repl [app-atom] (let [repl-out-text-area (rsyntax/text-area :wrap-lines? false @@ -136,9 +136,9 @@ repl-input-vertical-panel repl-out-writer repl-split-pane)) - repl-split-pane)) + repl-split-pane)) -(defn make-doc-nav-comp +(defn doc-nav [app-atom] (let [completion-label (label :text "Name search" :id :doc-nav-label @@ -162,7 +162,7 @@ completion-panel)) -(defn make-doc-view-comp +(defn doc-view [app-atom] (let [help-text-area (rsyntax/text-area :wrap-lines? true @@ -178,48 +178,14 @@ help-text-area help-text-scroll-pane)) help-text-scroll-pane)) - -(defn add-behaviors - [app] - ;; docs - (setup-completion-list (app :completion-list) app) - (setup-tab-help app (app :doc-text-area)) - ;;editor - (setup-autoindent (app :doc-text-area)) - (doto (app :doc-text-area) attach-navigation-keys) - (double-click-selector (app :doc-text-area)) - (add-caret-listener (app :doc-text-area) #(display-caret-position app)) - (setup-search-text-area app) - (activate-caret-highlighter app) - (setup-temp-writer app) - (attach-action-keys (app :doc-text-area) - ["cmd1 ENTER" #(send-selected-to-repl app)]) - ;; repl - (setup-autoindent (app :repl-in-text-area)) - (setup-tab-help app (app :repl-in-text-area)) - (doto (app :repl-in-text-area) - double-click-selector - attach-navigation-keys) - ;; global - (dorun (map #(attach-global-action-keys % app) - [(app :docs-tree) - (app :doc-text-area) - (app :repl-in-text-area) - (app :repl-out-text-area) - (.getContentPane (app :frame))])) - ;; frame - ) (defn create-app [] (let [app-init (atom {}) - - editor (make-text-editor-comp app-init) - file-tree (make-file-tree-comp app-init) - repl (make-repl-comp app-init) - - doc-view (make-doc-view-comp app-init) - doc-nav (make-doc-nav-comp app-init) - + editor (text-editor app-init) + file-tree (file-tree app-init) + repl (repl app-init) + doc-view (doc-view app-init) + doc-nav (doc-nav app-init) doc-split-pane (left-right-split file-tree editor @@ -239,7 +205,6 @@ :on-close :exit :minimum-size [500 :by 350] :content split-pane) - app (merge {:file (atom nil) :repl (atom (create-outside-repl (@app-init :repl-out-writer) nil)) :changed false} @@ -250,6 +215,35 @@ split-pane))] app)) +(defn add-behaviors + [app] + ;; docs + (setup-completion-list (app :completion-list) app) + (setup-tab-help app (app :doc-text-area)) + ;;editor + (setup-autoindent (app :doc-text-area)) + (doto (app :doc-text-area) attach-navigation-keys) + (double-click-selector (app :doc-text-area)) + (add-caret-listener (app :doc-text-area) #(display-caret-position app)) + (setup-search-text-area app) + (activate-caret-highlighter app) + (setup-temp-writer app) + (attach-action-keys (app :doc-text-area) + ["cmd1 ENTER" #(send-selected-to-repl app)]) + ;; repl + (setup-autoindent (app :repl-in-text-area)) + (setup-tab-help app (app :repl-in-text-area)) + (doto (app :repl-in-text-area) + double-click-selector + attach-navigation-keys) + ;; global + (dorun (map #(attach-global-action-keys % app) + [(app :docs-tree) + (app :doc-text-area) + (app :repl-in-text-area) + (app :repl-out-text-area) + (.getContentPane (app :frame))]))) + (defonce current-app (atom nil)) (defn -show [] diff --git a/src/clooj/dev_tools.clj b/src/clooj/dev_tools.clj index a76aeb4..833c8cb 100644 --- a/src/clooj/dev_tools.clj +++ b/src/clooj/dev_tools.clj @@ -209,8 +209,7 @@ (let [pos (@caret-position text-comp) text (get-text-str text-comp)] (when-not (= pos old-pos) - (let [arglist-text - (arglist-from-caret-pos app ns text pos)] + (let [arglist-text (arglist-from-caret-pos app ns text pos)] (awt-event (.setText (:arglist-label app) arglist-text))))) (catch Throwable t (.printStackTrace t))))))) diff --git a/src/clooj/help.clj b/src/clooj/help.clj index 2e21821..077201f 100644 --- a/src/clooj/help.clj +++ b/src/clooj/help.clj @@ -111,7 +111,7 @@ (defn ns-available-names [app] - (parse-ns-form (current-ns-form app))) + (parse-ns-form (current-ns-form app))) (defn arglist-from-var-map [m] (or