135 |
136 | ## Model
137 | - Complete Document
138 | - Keep track of changes (implement history or some scheme where changes are registered and kept in a clojure ordered data
139 | structure)
140 | - Allow incremental view updates.
141 | - Undo/Redo
142 |
143 | ## App
144 | - Define the way plugins/add-ons are loaded.
145 | - Link Document to ui/text-editor.
146 | - Establish the way key bindings are defined.
147 | - Plugin management:
148 | - Unload a plugin.
149 | - Keep track of what plugins have been loaded.
150 |
--------------------------------------------------------------------------------
/docs/design/Acciones.Texto.tif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/design/Acciones.Texto.tif
--------------------------------------------------------------------------------
/docs/design/Doc.tif:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/design/Doc.tif
--------------------------------------------------------------------------------
/docs/design/Model.eap:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/design/Model.eap
--------------------------------------------------------------------------------
/docs/design/mockups/main.bmml:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 | 23
6 | true
7 | true
8 | true
9 | true
10 | macho
11 | 26
12 | false
13 |
14 |
15 |
16 |
17 | Esconder%20el%20menu%20a%20menos%20que%20se%20presione%20Alt/Cmd%20o%20Ctrl.
18 |
19 |
20 |
21 |
22 | Posibilidad%20de%20buscar%20comandos%20por%20tags.%20Todos%20los%20comandos%20deben%20proporcionar%20tags.%20Debe%20existir%20una%20vista%20que%20los%20muestre%20por%20nombre%20y%20por%20tag.
23 |
24 |
25 |
26 |
27 | F%20some_lib%0A.f%20core%0A.-core.clj%0A.-out.clj
28 |
29 |
30 |
31 |
32 | 0
33 | true
34 | true
35 | true
36 | repl
37 | 26
38 | true
39 |
40 |
41 |
42 |
43 | Alt%20for%20menu%20visibility%20/%20Alt+x%20for%20typing%20command
44 |
45 |
46 |
47 |
48 | 1
49 | none
50 | 0
51 | left
52 | top
53 | core.clj%2C%20out.clj%2C%20Namespaces%20Map
54 | 0
55 | true
56 |
57 |
58 |
59 |
60 | %28ns%20core%29%0A%20%0A%28defn%20some-core-fn%20%5C%5B%26%20args%5C%5D%0A%20%20%28let%20%5C%5B%7C%5C%5D%29%29
61 |
62 |
63 |
64 |
65 | disabled
66 | 1%0A2%0A3%0A4
67 |
68 |
69 |
70 |
71 | some-lib.core%3D%3E
72 |
73 |
74 |
75 |
--------------------------------------------------------------------------------
/docs/images/600px-UBA.svg_.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/images/600px-UBA.svg_.png
--------------------------------------------------------------------------------
/docs/images/Clojure.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/images/Clojure.png
--------------------------------------------------------------------------------
/docs/images/Segoecrg.ttf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/images/Segoecrg.ttf
--------------------------------------------------------------------------------
/docs/images/calendar.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/images/calendar.png
--------------------------------------------------------------------------------
/docs/images/editors.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/images/editors.png
--------------------------------------------------------------------------------
/docs/lab.core.keymap.md:
--------------------------------------------------------------------------------
1 | # Keymaps
2 |
3 | These entities are used to determine a mapping between a given keystroke and the command that should be executed when it is pressed. They are mainly used in the definition of [plugin][1]s or when assigning a [key handler](#missing-link) to a UI component.
4 |
5 | Keystrokes can be expressed as a string with each key that forms a part of it separated by a space (e.g. "ctrl alt del"). A list of all the keys that can be used are in [this][2] document. Additionally characters can be partof a keystroke description, this means that the keystroke `(` is recognized when the combination that would insert a `(` is pressed.
6 |
7 | The `shift` is for the moment a special case and can't be used to describe a keystroke. This is due to the fact that a keystroke that results in a character obtained through the use of the shift key (e.g. `shift 9` equals `)` in a given configuration) would map to various expressions (i.e. `shift 9` and `)`) which is ambiguous.
8 |
9 | ## Plugin Keymaps
10 |
11 | When specifying a plugin's keymaps, these can be defined at the `:global`, `:lang`uage and `:local` levels.
12 |
13 | - `:global` keymaps determine the menu items that are shown in the main application's menu, some values included in the keymap's commands determine how these items are added. All of these commands are accesible from within any context.
14 |
15 | - `:lang`uage keymaps hold commands that apply to all document of a specific language. They are loaded into the a document's context when it is opened and the language is assigned.
16 |
17 | - `:local` keymaps apply only to a single document.
18 |
19 | ## Event Keymaps
20 |
21 | All keymaps used as event handlers are always considered `:local` and have to be associated to a key event, otherwise the event generated won't contain the information necessary to map to a keystroke.
22 |
23 | ## Definition
24 |
25 | A keymap is defined by providing a name, a type (`:global`, `:lang` or `:local`) and any number of commands that are added with their corresponfing keystrokes.
26 |
27 | (km/keymap "Markdown"
28 | :local
29 | {:keystroke "ctrl p" :fn ::show-preview :name "Html Preview"})
30 |
31 | Commands are just maps that should contain two mandatory keywords: `:keystroke` and `:fn`. The former should have a keystroke value expressed as a string as explained above. The latter can be either a function, a var or a namespace qualified keyword that maps to an existing var.
32 |
33 | Optional keys for commands include the follwing:
34 |
35 | - `:name` should be a descriptive name for the commands. In `:global` keymaps this will be used as the text for the menu item. For all keymaps it will be used as the description for the contextual help dialog.
36 | - `:category` is used for `:global` keymaps to determine where the menu item should be added. Menu levels are determined through the use of the character `>` so a command which should inserted under the `File > Projects` should include this string as the value for the `:category` key.
37 |
38 | There is a feature which allows to specify the order in which the item in a `:global` keymap should be added, but it's still experimental and not so user friendly for now.
39 |
40 | [1]: ./lab.core.plugin.md
41 | [2]: ./lab.core.keymap-keys.md
--------------------------------------------------------------------------------
/docs/lab.core.lang.md:
--------------------------------------------------------------------------------
1 | # Languages
2 |
3 | Languages define the basic functionality associated with a document. The language that corresponds to a document is determined based on the `:rank` function the language defines. This function returns a number between 0 and 1 that determines the likelihood that the document content's is in that language.
4 |
5 | All available languages are taken into consideration and the one that provides the highest likelihood is associated to the document. If there are two or more different languages that provide the same likelihood it is undetermined which one will be chosen. The most basic implementation for a `rank` function is included in `lab.core.lang` which consists of checking the file extension, returning `1` for a match and `0` otherwise.
6 |
7 | A default language is defined in the application's configuration map under the key `:default-lang`. The value that should be set under this key is the corresponding language `:id` field. If this is not customized in the configuration, the default language is `:plain-text`.
8 |
9 | ## Parse tree
10 |
11 | All documents have a language associated and every language can specify it own grammar using the syntax defined in the parsley library. Therefore it is possible to get the parse tree for those document where their languages have a well defined grammar. This parse tree is generated incrementally, again thanks to parsley.
12 |
13 | This parse tree can be used to do static analysis, syntax highlighting or autcompletion on the document's code (all of which are being currently done). A related gotcha is that there's a good chance that large documents take up too much space in memory, due to the tree and document representation used by the library.
14 |
15 | The parse tree for a document can be obtained with the `lab.core.lang/parse-tree` function.
16 |
17 | ## Language definition
18 |
19 | A language in its most basic form consists of the following fields:
20 |
21 | - `:id`: a unique identifier.
22 | - `:name`: descriptive name.
23 | - `:options`: parsley parser options.
24 | - `:grammar`: parsley grammar specification.
25 | - `:rank`: function that receives a file path and returns a likelihood between 0 and 1.
26 | - `:styles`: a map containing font styles as values and the names of terminals and non-terminals of the grammar as keys.
--------------------------------------------------------------------------------
/docs/lab.core.md:
--------------------------------------------------------------------------------
1 | # The Core
2 |
3 | The application's core deals with [initialization](#init) and primarily with the following entities:
4 |
5 | - [Documents](#documents)
6 | - [Languages](#languages)
7 | - [Keymaps](#keymaps)
8 | - [Plugins](#plugins)
9 |
10 | This document is just a brief introduction of the main pieces of functionality on which the whole of *Clojure Lab* is built upon. For a more detailed explantation on how each of these work please refer to their specific documents.
11 |
12 |
13 | ## Initialization
14 |
15 | There's really not that much happening from the core's point of view during initialization, only two main things actually.
16 |
17 | The first one is the fetching of any configuration file that may exist in the current directory where the program was executed. This configuration file contains such things as:
18 |
19 | - `:name`: the application's name, which is used as the main window title.
20 | - Plugins that should be loaded during initialization.
21 | - `:core-plugins`: these are the ones that define core functionality (e.g. creation of core commands and GUI).
22 | - `:plugins`: languages, file explorer, etc.
23 | - `:lang-plugins`: defined as a map which determines the plugins that are automatically loaded when a document of the indicated language is opened.
24 | - `:plugins-dir`: path to location where plugin source files can be found. This can be an absolute path or relative to the one where the application was started.
25 | - `:current-dir`: current directory.
26 | - `:default-lang`: default language to be used when no other is resolved when opening a document.
27 |
28 | The second thing that happens is the loading of all plugins listed in the configuration's `:core-plugins` and `:plugins` mentioned above. These plugins in turn have their own initialization functions, but the actions taken by them can vary widely.
29 |
30 | In particular, the `lab.core.main` plugin creates a basic GUI structure, which includes the commands necessary to manipulate documents, plus some other operations like moving from tab to tab, toggling fullscreen mode and some other minor features. There are some additional details related to event handling that are defined in this plugin but these will be addressed in the plugin's own documentation.
31 |
32 | ## App (TODO)
33 |
34 |
35 | ## Documents
36 |
37 | Like in most IDEs, work in *Clojure Lab* is centered around documents. Loading, modification, saving and closing, are all standard operations that are supported and implemented in the core. Keeping track of the documents that are currently opened, the one that's being used at the moment and switching between the opened documents, are the other sort of operations the core is concerned with.
38 |
39 | When opening a document, all existing languages are asked for a ranking number using a `rank` function that they should include in their implementation. The criteria currently used is based solely on the file extension associated with each document.
40 |
41 | (For more information see [Documents][2])
42 |
43 |
44 | ## Languages
45 |
46 | All languages are defined as plugins except for the plain text language, which is included in the implementation of the core language library.
47 |
48 | Among other things languages define the grammar that the [Parsley][1] library will use to parse the document, a language specific keymap and a ranking function that is used with each document to determine their language.
49 |
50 | (For more information see [Languages][3])
51 |
52 |
53 | ## Keymaps
54 |
55 | These are just mappings between a combination of keystrokes and a command.
56 |
57 | The app has an associated keymap were all global commands are defined. Since these commands are global they are added as menu options in the GUI's menu bar. Plugins can add global commands by defining a `:global` keymap, this allows them to expose a visible point of entry to their functionality.
58 |
59 | (For more information see [Keymaps][4])
60 |
61 |
62 | ## Plugins
63 |
64 | Almost all features and functionalies in **Clojure Lab** are defined in plugins. As mentioned in the [initialization](#init) section, there are a number of plugins that are loaded only once during this process, while others are loaded each time a document is opened according to the configuration defined in the `:lang-plugins` map.
65 |
66 | There are two types of plugins available, these are `:global` and `:local`. The former is meant for plugins that define either global functionality (i.e. find & replace, file explorer, messages notifier, etc.) or implement the base mechanisms that are completed whith the usage of behavior defined in other plugins (e.g. code outline).
67 |
68 | (For more information see [Plugins][5])
69 |
70 | [1]: https://github.com/cgrand/parsley/
71 | [2]: ./lab.model.document.md
72 | [3]: ./lab.core.lang.md
73 | [4]: ./lab.core.keymap.md
74 | [5]: ./lab.core.plugin.md
75 |
--------------------------------------------------------------------------------
/docs/lab.core.plugin.md:
--------------------------------------------------------------------------------
1 | # Plugins
2 |
3 | The namespace `lab.core.plugin` implements the inner workings of the [loading](#loading) and [unloading](#unloading) of plugin, along with the macro `defplugin` which is used for their [definition](#definition) and creation. Most functionality is defined and implemented through plugins, which can be of two types: `:global` and `:local`.
4 |
5 | `:global` plugins are meant for the ones that implement functionality that should be avaialble accross the whole application. These can be plugins that are either project/language agnostic (e.g. find & replace), or that should be globally available for a given project/language (e.g. the languages themselves, Clojure's nREPL).
6 |
7 | `:local` plugins are more closely related to a document and its language, such as auto-complete and syntax-highlighting.
8 |
9 | ## Definition
10 |
11 | A plugin is created through the use of `defplugin`, which defines a var named `plugin` with its definition in the current namespace. There are a number of fields associated with the definition of a plugin, except for the `name` all of the others are optional.
12 |
13 | Usage:
14 |
15 | (defplugin 'plugin-name
16 | "Some docstring for the plugin var."
17 | :type :global
18 | :keymaps [km1 km2 km3 ,,,]
19 | :hooks {target-var1 hook-fn1 ,,,}
20 | :init! init-fn!
21 | :unload! unload-fn!)
22 |
23 | - `name` can be a symbol, a keyword or a string, all the rest of the fields are optional except for the `:type`:
24 | - `:type` possible values are `:global` or `:local`.
25 | - `:keymaps` vector that holds keymaps of different types which will be registered and unregisterd with the multimethods defined in `lab.core.keymap`.
26 | - `:hooks` map with vars as keys and fns (or vars holding fns) as values, which will be used as a hook using the `robert-hooke` library.
27 | - `:init!` function that takes a single argument which is the atom holding the whole app.
28 | - `:unload!` function that takes a sinlge argument which is the atom holding the whole app.
29 |
30 | ## Loading
31 |
32 | While `:global` plugins when loaded are registered in the application, `:local` plugins are registered in the application's current document. If a plugin is already loaded (which is detected by checking the registered plugins) then nothing is done.
33 |
34 | The order of actions during the loading of a plugin is the following:
35 |
36 | 1. Register Plugin (in the app or current document).
37 | 2. Add Hooks (if any).
38 | 3. Invoke the `init!` function (if defined).
39 | 4. Register Keymaps (if any).
40 |
41 | These are all side-effecting functions since at all times the application's atom is passed around. Adding hooks to a function using the `robert-hooke` library is also a side-effecting function.
42 |
43 | ## Unloading
44 |
45 | The process of unloading a plugin basically follows the same steps as the loading but all modifications are undone:
46 |
47 | 1. Unregister Plugin (in the app or current document).
48 | 2. Remove Hooks (if any).
49 | 3. Invoke the `unload!` function (if defined).
50 | 4. Unregister Keymaps (if any).
51 |
--------------------------------------------------------------------------------
/docs/lab.model.document.md:
--------------------------------------------------------------------------------
1 | # Documents
2 |
3 | The application keeps a set of all the opened documents and the current document being edited. The most defining attribute of a document is its language since it determines the way it will be parsed and some the functionality available by default when working on it. The language assigned to a document is defined based on the `:rank` function defined for each language (for more information see [languages][1]).
4 |
5 | An incremental buffer (taken from [parsley][1]) is associated to each document at the time of its creation. The buffer is the text representation of the document's content and is incrementally parsed according to the language defined for the document, so you can always get an up to date parse tree for any given document.
6 |
7 | ## History
8 |
9 | Every document keeps a history of the operations that are applied to it, which makes it trivial to implement the redo and undo functionalities. Each item in the history is composed of entities that implement the `lab.model.history.Undoable` protocol. When operations are not meant to be added to the history (e.g. executing operations that redo or undo others) the `with-no-history` macro is used.
10 |
11 | Multiple operations can be bundled up as a single one using the `bundle-operations` macro, this allows to encapsule related modifications to the document in a single operation, which comes in handy when implementing some operations (e.g paredit text editing commands).
12 |
13 | [1]: ./lab.core.lang.md
14 | [2]: https://github.com/cgrand/parsley/
15 |
--------------------------------------------------------------------------------
/docs/lab.ui.events.md:
--------------------------------------------------------------------------------
1 | # UI Events
2 |
3 |
--------------------------------------------------------------------------------
/docs/lab.ui.md:
--------------------------------------------------------------------------------
1 | # UI
2 |
3 | - Component hierarchy
4 | - Hiccup style component definition
5 | - Selection library
6 | - Events
7 | - Public API: attributes and functions
8 |
--------------------------------------------------------------------------------
/docs/manual.md:
--------------------------------------------------------------------------------
1 | # User Manual
2 |
3 | Once the application start you see the following screen:
4 |
5 | ![][initial-screen]
6 |
7 | A very simple and clean start up screen with a **File Explorer** control on the left and a main menu on the top.
8 |
9 | ## Getting Help
10 |
11 | At any moment, you can get a list of the commands available by pressing F1. This will show you a list of commands, their descriptions and shortcuts that you press to use them.
12 |
13 | ![][help]
14 |
15 | ## File Explorer
16 |
17 | This control allows you to browse and open any number of directories, which will be added as items and will let you access in a quick and practical way, the files you will be working with. To add a directory simply press Ctrl+D or the button **Add dir** on the top of the control.
18 |
19 | ![][file-explorer]
20 |
21 | To remove a directory you no longer want to work with select it and then press Del, this will only remove it from the control, not your file system. The dialog is closed by pressing Esc.
22 |
23 | ![][file-explorer-remove]
24 |
25 | Appart from being able to open a file through a traditional file dialog, the **File Explorer** provides a fast file access command in which you can type in any part of the name of the file you want to open and a list of possible matches will be offered. The search is done in all chlidren of the added directories, if none is added then it will be done on the directory and all subdirectories from which the application was started. This fast file search can be opened through the shortcut Ctrl+Alt+O.
26 |
27 | ![][file-explorer-search-open]
28 |
29 | ## Editing Documents
30 |
31 | Every document has a language associated to it, the default language for a new document is the `:plain-text` language. There are currently only two other languages available which are `:clojure` and `:markdown`. Each language determines the syntax highlighting and other commands included in itself. For example `:markdown` provides shortcuts to apply emphasis or mark text as code.
32 |
33 | Languages are currently assigned solely based on the document's path extension, `.md` for **Markdown** and `.clj` or `.cljs` for **Clojure**. The following image shows the looks of a Markdown and a Clojure file being edited.
34 |
35 | ![][editing-markdown]
36 |
37 | ![][editing-clojure]
38 |
39 | It's worth repeating that while editing your documents you can get a quick reminder of all available commands by pressing F1.
40 |
41 | [initial-screen]: https://raw.github.com/jfacorro/clojure-lab/master/docs/screenshots/initial-screen.png
42 | [help]: https://raw.github.com/jfacorro/clojure-lab/master/docs/screenshots/help.png
43 | [file-explorer]: https://raw.github.com/jfacorro/clojure-lab/master/docs/screenshots/file-explorer.png
44 | [file-explorer-remove]: https://raw.github.com/jfacorro/clojure-lab/master/docs/screenshots/file-explorer-remove.png
45 | [file-explorer-search-open]: https://raw.github.com/jfacorro/clojure-lab/master/docs/screenshots/file-explorer-search-open.png
46 | [editing-markdown]: https://raw.github.com/jfacorro/clojure-lab/master/docs/screenshots/editing-markdown.png
47 | [editing-clojure]: https://raw.github.com/jfacorro/clojure-lab/master/docs/screenshots/editing-clojure.png
48 |
--------------------------------------------------------------------------------
/docs/parser/Not+so+Homoiconic.pdf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/parser/Not+so+Homoiconic.pdf
--------------------------------------------------------------------------------
/docs/parser/lenses-etapsslides.pdf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/parser/lenses-etapsslides.pdf
--------------------------------------------------------------------------------
/docs/pocs/macho UI/css/ui.css:
--------------------------------------------------------------------------------
1 | html, body, * {
2 | margin: 0px;
3 | padding: 0px;
4 | list-style: none;
5 | font-family: Arial, Helvetica, sans-serif;
6 | font-size: 12px;
7 | }
8 |
9 | canvas {
10 | border: 1px solid #000;
11 | }
12 | span {
13 | position:absolute;
14 | top: 0px;
15 | left: 0px;
16 | }
17 | #workarea {
18 | float:left;
19 | }
20 | #menu {
21 | float:left;
22 | width: 150px;
23 | border: 1px solid #CCC;
24 | }
--------------------------------------------------------------------------------
/docs/pocs/macho UI/js/ui.js:
--------------------------------------------------------------------------------
1 | var ui = {
2 | stage : null,
3 | scale: 1,
4 | zoomFactor : 1.1,
5 | origin : { x : 0, y : 0},
6 | zoom : function(event) {
7 | event.preventDefault();
8 | var evt = event.originalEvent,
9 | mx = evt.clientX - ui.stage.content.offsetLeft,
10 | my = evt.clientY - ui.stage.content.offsetTop,
11 | wheel = evt.wheelDelta / 120;//n or -n
12 |
13 | var zoom = (ui.zoomFactor - (evt.wheelDelta < 0 ? 0.2 : 0));
14 | var newscale = ui.scale * zoom;
15 | ui.origin.x = mx / ui.scale + ui.origin.x - mx / newscale;
16 | ui.origin.y = my / ui.scale + ui.origin.y - my / newscale;
17 |
18 | ui.stage.setOffset(ui.origin.x, ui.origin.y);
19 | ui.stage.setScale(newscale);
20 | ui.stage.draw();
21 |
22 | ui.scale *= zoom;
23 | },
24 | addNamespace : function() {
25 | var layer = new Kinetic.Layer({draggable : true});
26 |
27 | var ns = new Kinetic.Circle({
28 | x: 100,
29 | y: 100,
30 | radius: 50,
31 | fill: '#00D2CC',
32 | stroke: 'black',
33 | strokeWidth: 2
34 | });
35 |
36 | // add cursor styling
37 | ns.on('mouseover', function() {
38 | document.body.style.cursor = 'pointer';
39 | });
40 | ns.on('mouseout', function() {
41 | document.body.style.cursor = 'default';
42 | });
43 |
44 | layer.add(ns);
45 | ui.stage.add(layer);
46 |
47 | return layer;
48 | },
49 | addDefinition : function() {
50 | var def = new Kinetic.Circle({
51 | x: 100,
52 | y: 50 + (++d * 10),
53 | radius: 10,
54 | fill: '#11D2FF',
55 | stroke: '#CCC',
56 | strokeWidth: 1,
57 | draggable: true
58 | });
59 |
60 | def.on('mouseover', function() {
61 | document.body.style.cursor = 'pointer';
62 | });
63 | def.on('mouseout', function() {
64 | document.body.style.cursor = 'default';
65 | });
66 |
67 | ui.stage.off('click');
68 | ui.stage.on('click', function() {
69 | ui.stage.off('click');
70 | var pos = ui.stage.getMousePosition();
71 | var result = ui.stage.getIntersection(pos);
72 | result.shape.getParent().add(def);
73 |
74 | });
75 | }
76 | };
77 |
78 | var d = 0;
79 |
80 | $(function() {
81 | var width = $(document).width() - 155, height = $(document).height() - 5;
82 | var stage = ui.stage = new Kinetic.Stage({
83 | container: 'workarea',
84 | width: width,
85 | height: height
86 | });
87 |
88 | $(stage.content).on('mousewheel', ui.zoom);
89 | $('#options .add-ns').on('click', ui.addNamespace);
90 | $('#options .add-def').on('click', ui.addDefinition);
91 | });
--------------------------------------------------------------------------------
/docs/pocs/macho UI/ui.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
18 |
19 |
20 |
--------------------------------------------------------------------------------
/docs/pre/Cronograma.mpp:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/pre/Cronograma.mpp
--------------------------------------------------------------------------------
/docs/pre/Funcionalidades.docx:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/pre/Funcionalidades.docx
--------------------------------------------------------------------------------
/docs/pre/presentacion.docx:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/pre/presentacion.docx
--------------------------------------------------------------------------------
/docs/screenshots/clojure-autcomplete-context.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/clojure-autcomplete-context.png
--------------------------------------------------------------------------------
/docs/screenshots/clojure-autcomplete-options.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/clojure-autcomplete-options.png
--------------------------------------------------------------------------------
/docs/screenshots/clojure-delim-match-after.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/clojure-delim-match-after.png
--------------------------------------------------------------------------------
/docs/screenshots/clojure-delim-match-before.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/clojure-delim-match-before.png
--------------------------------------------------------------------------------
/docs/screenshots/clojure-docstring.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/clojure-docstring.png
--------------------------------------------------------------------------------
/docs/screenshots/clojure-macroexpand.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/clojure-macroexpand.png
--------------------------------------------------------------------------------
/docs/screenshots/clojure-nrepl-code.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/clojure-nrepl-code.png
--------------------------------------------------------------------------------
/docs/screenshots/clojure-nrepl-eval.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/clojure-nrepl-eval.png
--------------------------------------------------------------------------------
/docs/screenshots/clojure-nrepl-open.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/clojure-nrepl-open.png
--------------------------------------------------------------------------------
/docs/screenshots/clojure-rainbow-cycle.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/clojure-rainbow-cycle.png
--------------------------------------------------------------------------------
/docs/screenshots/clojure-syntax-hl.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/clojure-syntax-hl.png
--------------------------------------------------------------------------------
/docs/screenshots/editing-clojure.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/editing-clojure.png
--------------------------------------------------------------------------------
/docs/screenshots/editing-markdown.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/editing-markdown.png
--------------------------------------------------------------------------------
/docs/screenshots/editor-line-numbers.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/editor-line-numbers.png
--------------------------------------------------------------------------------
/docs/screenshots/editor-no-line-numbers.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/editor-no-line-numbers.png
--------------------------------------------------------------------------------
/docs/screenshots/file-close-confirm.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/file-close-confirm.png
--------------------------------------------------------------------------------
/docs/screenshots/file-close-tab-button.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/file-close-tab-button.png
--------------------------------------------------------------------------------
/docs/screenshots/file-edit.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/file-edit.png
--------------------------------------------------------------------------------
/docs/screenshots/file-explorer-remove.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/file-explorer-remove.png
--------------------------------------------------------------------------------
/docs/screenshots/file-explorer-search-open.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/file-explorer-search-open.png
--------------------------------------------------------------------------------
/docs/screenshots/file-explorer.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/file-explorer.png
--------------------------------------------------------------------------------
/docs/screenshots/file-multiple-tabs.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/file-multiple-tabs.png
--------------------------------------------------------------------------------
/docs/screenshots/file-new.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/file-new.png
--------------------------------------------------------------------------------
/docs/screenshots/file-open-dialog.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/file-open-dialog.png
--------------------------------------------------------------------------------
/docs/screenshots/file-open.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/file-open.png
--------------------------------------------------------------------------------
/docs/screenshots/file-save-dialog.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/file-save-dialog.png
--------------------------------------------------------------------------------
/docs/screenshots/find-dialog-selection-next.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/find-dialog-selection-next.png
--------------------------------------------------------------------------------
/docs/screenshots/find-dialog-selection.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/find-dialog-selection.png
--------------------------------------------------------------------------------
/docs/screenshots/find-dialog.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/find-dialog.png
--------------------------------------------------------------------------------
/docs/screenshots/find-in-files-dialog-complete.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/find-in-files-dialog-complete.png
--------------------------------------------------------------------------------
/docs/screenshots/find-in-files-dialog.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/find-in-files-dialog.png
--------------------------------------------------------------------------------
/docs/screenshots/find-in-files-result.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/find-in-files-result.png
--------------------------------------------------------------------------------
/docs/screenshots/help.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/help.png
--------------------------------------------------------------------------------
/docs/screenshots/initial-screen.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/initial-screen.png
--------------------------------------------------------------------------------
/docs/screenshots/markdown-code-outline.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/markdown-code-outline.png
--------------------------------------------------------------------------------
/docs/screenshots/markdown-preview.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/markdown-preview.png
--------------------------------------------------------------------------------
/docs/screenshots/markdown-syntax-hl.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/markdown-syntax-hl.png
--------------------------------------------------------------------------------
/docs/screenshots/outline-open.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/outline-open.png
--------------------------------------------------------------------------------
/docs/screenshots/outline-position.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/outline-position.png
--------------------------------------------------------------------------------
/docs/screenshots/replace-dialog.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/screenshots/replace-dialog.png
--------------------------------------------------------------------------------
/docs/test/markdown-test.md:
--------------------------------------------------------------------------------
1 | Headers
2 | =======
3 |
4 | Title
5 | =
6 | Title
7 | ====
8 |
9 | Title
10 | -
11 |
12 | Title
13 | --
14 |
15 | # Title
16 | ## Title
17 | ### Title
18 | #### Title
19 | ##### Title
20 | ###### Title
21 |
22 | ## Title #
23 |
24 | Html
25 | ====
26 |
27 |
29 | sdcsdcs
30 |
31 |
32 | Emphasis
33 | ========
34 |
35 | *em*
36 |
37 | **strong**
38 |
39 | Lists
40 | =====
41 |
42 | - item
43 | - item
44 | - item
45 |
46 | + item
47 | + item
48 | + item
49 |
50 | * item
51 | * item
52 | * item
53 |
54 |
55 | 1. item
56 | 2. item
57 | 3. item
58 | 300001. item
59 |
60 | - This causes an ambiguous match
61 |
62 | Nested Lists
63 | ============
64 |
65 | - level 1
66 | - level 2
67 | - level 3
68 |
69 | Code
70 | =====
71 |
72 | *Code with spaces*
73 |
74 | (defn f [x]
75 | (println x)
76 |
77 | *Code with tabs*
78 |
79 | (defn f [x]
80 | (println x)
81 |
82 | ``this is some code``
83 |
84 | `this is some code`
85 |
86 | `this is some code`this should not be some code`
87 |
88 | Links
89 | =====
90 |
91 | [inline link](http://link.com)
92 |
93 | [reference link][id]
94 |
95 | [id]: dcsdcs
96 |
97 | [implicit link][]
98 |
99 | Blockquote
100 | ===========
101 |
102 | > This is some quote
103 | > taking two lines
104 |
105 | > Block quote >
107 |
108 |
109 | Title after some text # fvdfvdfvd
110 | Dash after some text - ss
111 | Block quote after some text > dfcdfvdf
112 |
113 |
--------------------------------------------------------------------------------
/docs/typing/ambrose-honours.pdf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/docs/typing/ambrose-honours.pdf
--------------------------------------------------------------------------------
/docs/user-manual/code-outline.md:
--------------------------------------------------------------------------------
1 | This control shows you an overview of the elements defined in the file you are working on. The types of elements listed depend on the language associated to the file, if the language has no support for **Code Outline** then no elements will be shown.
2 |
3 | In order to enable **Code Outline** for the current file, press the Alt + O key combination or click on the menu item **View > Outline**. This will display a new tab in the right section of the application, in which you will be able to see a list.
4 |
5 |
6 |
7 | Every item in that list corresponds to an element defined in the contents of the associated file.
8 |
9 | ## Moving to the Element
10 |
11 | Having a **Code Outline** is particularly useful when working with large files since the amount of elements tends to increase with the size of the file. Finding a specific element can sometimes be quite hard when there are too many of them.
12 |
13 | In order to get the cursor in the position where the definition of each element is, double-click on the item or select it and press the Enter key.
14 |
15 |
16 |
17 | ## Finding an Element
18 |
19 | It's possible for you to search for a specific element by selecting any of the items in the list and start typing the name of the element. If found this will change the focus to the element with the name you type so you can simply press Enter and the cursor will be positioned where that element is defined.
20 |
21 |
--------------------------------------------------------------------------------
/docs/user-manual/editor.md:
--------------------------------------------------------------------------------
1 | The **Editor** is the control you use to modify the content of your files. In general, every tab that's located in the central section of the application is most likely an **Editor**.
2 |
3 | By default every editor shows the number of each line in your file, you can hide these by pressing Ctrl + L .
4 |
5 |
6 |
7 | And show them again using the same key combination.
8 |
9 |
10 |
11 | ## Undoing and Redoing Changes
12 |
13 | It is possible for you to **undo** or **redo** an unlimited number of operations on a file. These two commands can be applied through the **Edit > Undo** and **Edit > Redo** menu items or through their respective shortcuts, Ctrl + Z and Ctrl + Y .
14 |
15 | ## Language Support
16 |
17 | Every file has a language associated to it, the default language for a new file is the plain text language. There are currently only two other languages available which are [Clojure](Clojure) and [Markdown](Markdown). Each language specifies details such as how to format the syntax highlighting, availabe operations on their structures and such things. For example **Markdown** provides shortcuts to apply emphasis to a piece of text or to apply code format to it.
18 |
19 | Languages are currently assigned solely based on the document's path extension, `.md` for **Markdown** and `.clj` or `.cljs` for **Clojure**.
20 |
21 | ## Contextual Help
22 |
23 | While editing your file you can get a quick reminder of all available commands by pressing F1 . Listed commands will also include the ones loaded based on the file's associated language.
--------------------------------------------------------------------------------
/docs/user-manual/file-explorer.md:
--------------------------------------------------------------------------------
1 | This control allows you to browse and open any number of directories, which will be added as items and will let you access in a quick and practical way all the files you will be working with.
2 |
3 | ## Add a Directory
4 |
5 | To add a directory simply press Ctrl + D or the button + Add dir on the top of the control.
6 |
7 |
8 |
9 | ## Remove a Directory
10 |
11 | To remove a directory you no longer want to work with, select it and then press Del, this will only remove it from the control, not your file system. The dialog is closed by pressing Esc.
12 |
13 |
14 |
15 | ## Search & Open a Document
16 |
17 | Apart from being able to open a file through a traditional file dialog ( **File > Open** ), the **File Explorer** provides a *fast file access dialog*, in which you can enter any part of the name of the file you want to open and a list of possible matches will be offered.
18 |
19 | The search is done in all chlidren of the added directories, if none is added then it will be done on the directory and all subdirectories from which the application was started. This fast file search can be opened through the shortcut Ctrl + Alt + O .
20 |
21 |
--------------------------------------------------------------------------------
/docs/user-manual/find-replace.md:
--------------------------------------------------------------------------------
1 | The ability to find some specific text in the contents of your file is always available as well as being able to replace a piece of this content for another.
2 |
3 | You can find all related find and replace commands under the **Edit** menu, which are the following.
4 |
5 | ## Find
6 |
7 | This command will show you a dialog when you press Ctrl + F or click the menu item **Edit > Find**.
8 |
9 |
10 |
11 | Enter the the text you want to find in the text field and then click the **Find Next** button or press the Enter . When a match is found it will be selected and the cursor will move to the beginning of that selection.
12 |
13 |
14 |
15 | By pressing the button or the Enter key again, **Clojure Lab** will search for the next match, if there is none the cursor will stay put.
16 |
17 |
18 |
19 | A closely related command to **Find** is the **Find Next**. Once you close the **Find** dialog you will be able to repeat the search for the last term you entered there by pressing F3 or clicking the menu item **Edit > Find Next**.
20 |
21 | ## Replace
22 |
23 | Replacing text in a file works pretty much the same as finding it, the only difference is you also specify the text that will replace the original one. Activate this command by pressing Ctrl + H or cliking **Edit > Replace**.
24 |
25 |
26 |
27 | To perform a replacement follow these steps:
28 |
29 | 1. Enter the text that will be replaced in the **Find** field.
30 | 2. Enter the replacement text in the **Replace** field.
31 | 3. Press the **Find Next** button to find a match.
32 | 4. If a match is found press the **Replace** button to apply the replacement and search for the next match.
33 |
34 | Alternatively you can press the **Replace All** button which will perform a replacement for all matches. This is useful when you are sure that every ocurrence of the text should be replaced.
35 |
36 | ## Find in Files
37 |
38 | Since sometimes you need to find text in multiple files the **Find in Files** command lets you do just that. You will see the following dialog after pressing Alt + F or cliking the menu item **Edit > Find in Files**.
39 |
40 |
41 |
42 | As in the previous commands, there is a **Find** field where you enter the text you need to find and there's also a **Browse** button in order for you to select a directory. The search will include all files in this directory and will also include all children directories if you choose to do so by activating the **Recursive** checkbox.
43 |
44 |
45 |
46 | Once you have added all the necessary information, pressing the **Find All** button will open a tab in the lower section of **Clojure Lab**. In this tab you will find the results of the search in the form of a tree.
47 |
48 |
49 |
50 | Each leaf in the tree is a match of the search, to open the file where the match was found, double-click the item. This will not only open the file (if it was not already open) but it will also move the cursor to the position where the match is located.
--------------------------------------------------------------------------------
/docs/user-manual/getting-started.md:
--------------------------------------------------------------------------------
1 | Once the application starts you will see a very simple and clean start up screen with a [File Explorer](File-Explorer) control on the left and a main menu on the top.
2 |
3 |
4 |
5 | In the main menu you will find several commands to perform all kinds of actions. The following is a list of the default most important menu items:
6 |
7 | - **File**: create, open, save and close files.
8 | - **View**: hide/show controls, modify content layout.
9 | - **Edit**: undo/redo actions, find and replace, etc.
10 |
11 | In this **Getting Started** guide we will go through most of the commands under the **File** menu item, remaining commands will be covered in other sections.
12 |
13 | ## Creating, Editing and Saving a File
14 |
15 | In order to create a new file you should either click on the menu item **File > New** or just press the both the Ctrl + N key combination.
16 |
17 | You will see a new tab in the center section of the application. The title for this document will be **Untitled X**, where **X** is just a number that will increment with each creation of a new document.
18 |
19 |
20 |
21 | Once you have created the new file you can start editing its contents by just typing into it. You'll notice that once you start modifying the file, a little asterisk will appear to the right of the file's name (in this case **Untitled 2**). This asterisk means there are modifications done to the file that haven't been saved to disk.
22 |
23 |
24 |
25 | It is always a good idea to regulary save your changes to disk which you can do either through the **File > Save** menu item or by pressing the keys Ctrl + S . If the file is a new one a **Save File Dialog** will appear, which will ask you to select a directory and a name for your file.
26 |
27 |
28 |
29 | From this point on every time you modify the contents of the file and save these changes, they will be saved to the file you specified in the **Save File Dialog**.
30 |
31 | The extension in the name you provide when saving a file tells **Clojure Lab** what type of file it is you are editing. Based on this information **Clojure Lab** can provide other useful functionality while you edit your file. For more information about this and other interesting features, check the manual entry for the [Editor](Editor).
32 |
33 | ## Opening a File
34 |
35 | To open en existing file click the menu item **File > Open** this will show an **Open File Dialog** in which you will be able to find the file you want to open. Once you find it, just select it and click the **Open** button.
36 |
37 |
38 |
39 | This will open a tab in the center section of **Clojure Lab** with the contents of the file you selected and showing the filename as the tab's title.
40 |
41 |
42 |
43 | ## Closing a File
44 |
45 | Once you are done editing a file there are a number of ways of closing it:
46 |
47 | - Press the keys Ctrl + W to close the current file.
48 | - Click the menu item **File > Close** to close the current file.
49 | - Click on the X button of a specific tab to close the file associated with that tab.
50 |
51 |
52 |
53 | If there are changes to the file that haven't been saved **Clojure Lab** will ask you if you would like to save those changes. You can either choose to save them, ignore the changes or cancel the close operation.
54 |
55 |
56 |
57 | ## Working with Multiple Files
58 |
59 | It is possible to open any number of files in **Clojure Lab** in order to easily alternate work between them. When more than one file is open, you will see multiple tabs in the center section of the application. The current file on which you are working will be distinguished by a colored line right below the tab.
60 |
61 |
62 |
63 | In this screenshot the current file is the second one, named **Untitled 5**.
64 |
65 | ## What's Next?
66 |
67 | There are many other **Clojure Lab** important features you should explore, the following are just some of them:
68 |
69 | - [File Explorer](File-Explorer).
70 | - [Editor](Editor).
71 | - [Code Outline](Code-Outline).
72 | - [Find & Replace](Find-Replace).
73 |
74 | For a complete list of features please check the index in the [Home](Home) page.
75 |
76 |
--------------------------------------------------------------------------------
/docs/user-manual/helper.md:
--------------------------------------------------------------------------------
1 | At any moment, you can get a list of the commands available by pressing F1 . Depending on the context in which this commands is executed it will show something along the lines of the following list of commands, their descriptions and the shortcuts you can use to activate them.
2 |
3 |
4 |
5 | In order to close the help dialog just press the Esc key.
--------------------------------------------------------------------------------
/docs/user-manual/home.md:
--------------------------------------------------------------------------------
1 | The following sections will guide you through the different features available in **Clojure Lab**.
2 |
3 | - [Getting Started](Getting-Started)
4 | - [File Explorer](File-Explorer)
5 | - [Editor](Editor)
6 | - [Code Outline](Code-Outline)
7 | - [Find & Replace](Find-&-Replace)
8 | - [Notifier](Notifier)
9 |
10 | **Supported Languages**
11 |
12 | - [Clojure](Clojure)
13 | - [Markdown](Markdown)
14 |
15 | If you find that a subject is missing please feel free to open an issue.
16 |
--------------------------------------------------------------------------------
/docs/user-manual/markdown.md:
--------------------------------------------------------------------------------
1 | Nowadays there's a widespread usage of the **Markdown** language when writing all kinds of documents. For example, StackOverflow and GitHub use it as a default in all their text based content.
2 |
3 | Support for **Markdown** in **Clojure Lab** includes:
4 |
5 | - Syntax Highlighting.
6 | - Shortcuts for formatting text (emphasis, links and code).
7 | - Code Outline.
8 | - Preview of the file in HTML form.
9 |
10 | ## Syntax Highlighting
11 |
12 | This feature is always useful for identifying the different elements in the file visually. It is implemented as part of the **Markdown** language so you don't need to do anything in order to enable it.
13 |
14 |
15 |
16 | ## Shortcuts
17 |
18 | Available shortcuts let you add different types of emphasis and format a piece of text as code:
19 |
20 | - Ctrl + B : apply strong format to selection.
21 | - Ctrl + I : apply emphasis format to selection.
22 | - Ctrl + K : format selection as code.
23 | - Alt + K : format selection as a keyboard stroke.
24 | - Alt + L : format selection as a link.
25 |
26 | When there is no text selected each shortcut simply inserts the delimiters for each format, levaing the cursor in the middle so you can just type in the content.
27 |
28 | ## Code Outline
29 |
30 | When the **Code Outline** control is activated on a **Markdown** file, the elements displayed as the items in the list are all the titles present. The following is an example of the interaction between a file and the **Code Outline** control.
31 |
32 |
33 |
34 | As mentioned in the [Code Outline](Code-Outline) page, the list is always synchronized with the contents of the file.
35 |
36 | ## HTML Preview
37 |
38 | It is possible for you to get an HTML preview of your **Markdown** files by pressing the keys Ctrl + P while editing the file. This will open a tab in the right section of the application which will show you the preview.
39 |
40 |
41 |
42 | Just as the **Code Outline** is always up to date with the latest changes of the file, the preview is synchronized with its contents as well.
43 |
--------------------------------------------------------------------------------
/docs/user-manual/notifier.md:
--------------------------------------------------------------------------------
1 | While **Clojure Lab** might be a top notch development environment, errors are bound to happen and it is always nice for you to know what is going on. This is what the **Notifier** was built for.
2 |
3 | Every time there is something **Clojure Lab** needs you to know, the **Notifier** will create a tab in the lower part of the appliaction holding the information.
4 |
--------------------------------------------------------------------------------
/launch4j-win.cgf.xml:
--------------------------------------------------------------------------------
1 |
2 |
3 | false
4 | gui
5 | C:\Juan\Dropbox\Facultad\2012.Trabajo.Profesional\clojure-lab\target\lab.jar
6 | C:\Juan\Dropbox\Facultad\2012.Trabajo.Profesional\clojure-lab\target\lab.exe
7 |
8 |
9 | .
10 | normal
11 | http://java.com/download
12 |
13 | false
14 |
15 | C:\Juan\Dropbox\Facultad\2012.Trabajo.Profesional\clojure-lab\resources\icon-64.ico
16 |
17 |
18 | false
19 | 1.7.0_55
20 |
21 | preferJre
22 | 64/32
23 |
24 |
--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
1 | (defproject clojure-lab "0.1.0-beta"
2 | :description "Clojure Lab - A development environment for Clojure in Clojure."
3 | :dependencies [[org.clojure/clojure "1.6.0"]
4 | [org.clojure/core.match "0.2.1"]
5 | [org.clojure/core.async "0.1.267.0-0d7780-alpha"]
6 |
7 | [net.cgrand/parsley "0.9.2" :exclusions [org.clojure/clojure]]
8 | [popen "0.3.0"]
9 | [leiningen "2.3.4"]
10 | [org.clojure/tools.nrepl "0.2.3"]
11 |
12 | [com.cemerick/pomegranate "0.3.0"]
13 |
14 | [org.clojure/tools.logging "0.2.6"]
15 | [org.slf4j/slf4j-log4j12 "1.7.7"]
16 |
17 | [markdown-clj "0.9.44"]
18 |
19 | [clojure-watch "0.1.9"]]
20 | :plugins [[lein-cloverage "1.0.2"]]
21 | :uberjar-name "lab.jar"
22 | :java-source-paths ["src/java"]
23 | :source-paths ["src/clj"]
24 | :manifest {"SplashScreen-Image" "logo.png"}
25 | :aliases {"dev" ["do" "clean," "javac," "run-dev"]
26 | "run-dev" ["with-profile" "dev" "trampoline" "run"]
27 | "build" ["do" "clean," "uberjar"]
28 | "build-aot" ["with-profile" "aot" "build"]}
29 | :repositories [["local" "file:repo"]]
30 | :profiles {:dev {:dependencies [[org.clojure/tools.namespace "0.2.4"]]
31 | :main lab.main
32 | :debug true}
33 | :aot {:aot :all}
34 | :uberjar {:main lab.main
35 | :aot [lab.main #"lab.ui.*" #"lab.core.*"]}})
36 |
--------------------------------------------------------------------------------
/resources/add.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/add.png
--------------------------------------------------------------------------------
/resources/close-tab.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/close-tab.png
--------------------------------------------------------------------------------
/resources/collapse.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/collapse.png
--------------------------------------------------------------------------------
/resources/expand.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/expand.png
--------------------------------------------------------------------------------
/resources/file.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/file.png
--------------------------------------------------------------------------------
/resources/folder.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/folder.png
--------------------------------------------------------------------------------
/resources/fonts/ABeeZee-Regular.otf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/fonts/ABeeZee-Regular.otf
--------------------------------------------------------------------------------
/resources/fonts/Inconsolata.otf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/fonts/Inconsolata.otf
--------------------------------------------------------------------------------
/resources/fonts/LucidaTypewriterRegular.otf:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/fonts/LucidaTypewriterRegular.otf
--------------------------------------------------------------------------------
/resources/icon-16.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/icon-16.ico
--------------------------------------------------------------------------------
/resources/icon-16.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/icon-16.png
--------------------------------------------------------------------------------
/resources/icon-32.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/icon-32.ico
--------------------------------------------------------------------------------
/resources/icon-32.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/icon-32.png
--------------------------------------------------------------------------------
/resources/icon-64.ico:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/icon-64.ico
--------------------------------------------------------------------------------
/resources/icon-64.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/icon-64.png
--------------------------------------------------------------------------------
/resources/logo-in.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/logo-in.png
--------------------------------------------------------------------------------
/resources/logo.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/logo.png
--------------------------------------------------------------------------------
/resources/right-icon.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/right-icon.png
--------------------------------------------------------------------------------
/resources/search-icon.png:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/jfacorro/clojure-lab/f0b5a4b78172984fc876f063f66e5e1592178da9/resources/search-icon.png
--------------------------------------------------------------------------------
/src/clj/lab/core/keymap.clj:
--------------------------------------------------------------------------------
1 | (ns lab.core.keymap
2 | (:refer-clojure :exclude [find remove])
3 | (:require [clojure.string :as str]))
4 |
5 | (defn- ks->set [ks]
6 | (when ks
7 | (-> ks (str/split #" ") set)))
8 |
9 | (defn- add-command
10 | [km {ks :keystroke :as cmd}]
11 | (assoc-in km [:bindings (ks->set ks)] cmd))
12 |
13 | (defn commands
14 | "Returns a map with keymap names as keys and the commands as their values."
15 | [km]
16 | (let [kms (loop [{:keys [parent] :as km} km
17 | kms []]
18 | (or (and (not km) kms) (recur parent (conj kms km))))
19 | bindings (->> kms
20 | (map (fn [{:keys [name bindings]}]
21 | (reduce #(update-in %1 [%2] assoc :km-name name)
22 | bindings
23 | (keys bindings))))
24 | reverse
25 | (reduce merge {}))]
26 | (reduce (fn [cmds {:keys [km-name] :as cmd}]
27 | (update-in cmds [km-name]
28 | (fnil conj #{(dissoc cmd :km-name)})
29 | (dissoc cmd :km-name)))
30 | {}
31 | (vals bindings))))
32 |
33 | (defn- generate-id
34 | "Generates a namespace qualified keyword to be used
35 | as a keymap id."
36 | []
37 | (keyword (str (ns-name *ns*)) (str (gensym "id-"))))
38 |
39 | (defn keymap
40 | "Takes a name that should be a symbol or a keyword, a type (:global,
41 | :lang or :local) and any number of commands are added with their
42 | corresponding keystrokes."
43 | [name type & [lang & lang-cmds :as cmds]]
44 | (let [km {:id (generate-id)
45 | :name name
46 | :type type
47 | :bindings {}}]
48 | (if (= type :lang)
49 | (-> (reduce add-command km lang-cmds)
50 | (assoc :lang lang))
51 | (reduce add-command km cmds))))
52 |
53 | (defn find
54 | "Given a keystroke looks for the corresponding commands in
55 | the supplied keymap and if not found in its parent."
56 | [km ks]
57 | (when km
58 | (if-let [cmd (get-in km [:bindings ks])]
59 | cmd
60 | (recur (:parent km) ks))))
61 |
62 | (defn find-or
63 | "Takes a keymap and any number of keystrokes.
64 | Looks for the first keystroke that maps to a command
65 | and returns this command."
66 | [km & kss]
67 | (->> (map (partial find km) kss)
68 | (drop-while nil?)
69 | first))
70 |
71 | (defn append
72 | "Append a child keymap to an existinig one. If either one
73 | is nil the other is returned."
74 | [parent child]
75 | (cond
76 | (nil? parent) child
77 | (nil? child) parent
78 | :else (assoc child :parent parent)))
79 |
80 | (defn remove
81 | "Removes the keymap with the specified id from the
82 | keymap hierarchy."
83 | [top id]
84 | (loop [cur top
85 | prev nil]
86 | (cond
87 | (nil? cur) top
88 | (= (:id cur) id)
89 | (if (:parent cur)
90 | (append (:parent cur) prev)
91 | (dissoc prev :parent))
92 | :else (recur (:parent cur) cur))))
93 |
94 | (defmulti register-multi
95 | "Registers a keymap in x according to its type."
96 | (fn [x km] (:type km)))
97 |
98 | (defmulti unregister-multi
99 | "Registers a keymap in x according to its type."
100 | (fn [x km] (:type km)))
101 |
--------------------------------------------------------------------------------
/src/clj/lab/core/plugin.clj:
--------------------------------------------------------------------------------
1 | (ns lab.core.plugin
2 | "Plugins are defined in a namespace where the following vars
3 | should be defined:
4 |
5 | init! The initalizing function where the UI if any should be added.
6 | hooks A map where the keys are the target vars and the values are
7 | the functions that will be applied as hooks.
8 | keymap A keymap with global bindings that will be applied to the existing
9 | global keymap."
10 | (:require [robert.hooke :as hook]
11 | [lab.core.keymap :as km]
12 | [clojure.tools.logging :as log]))
13 |
14 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15 | ;; Hooks
16 |
17 | (defn- add-hooks!
18 | "Add the defined hooks and use the name
19 | of the plugin as the hooks' key."
20 | [hooks hook-key]
21 | (doseq [[target-var f] hooks]
22 | (log/info hook-key "- Adding hook" f "to" target-var)
23 | (hook/add-hook target-var hook-key f)))
24 |
25 | (defn- remove-hooks!
26 | "Remove the defined hooks using the name
27 | of the plugin as the hooks' key."
28 | [hooks hook-key]
29 | (doseq [[target-var f] hooks]
30 | (log/info hook-key "- Removing hook" f "in" target-var)
31 | (hook/remove-hook target-var hook-key)))
32 |
33 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
34 | ;; Keymaps
35 |
36 | (defn register-keymap!
37 | "Uses the register multi-method. This is created as a function
38 | so that plugins can add hooks."
39 | [app keymap]
40 | (swap! app km/register-multi keymap))
41 |
42 | (defn- register-keymaps!
43 | "Register all keymaps in the plugin."
44 | [app keymaps]
45 | (doseq [km keymaps]
46 | (register-keymap! app km)))
47 |
48 | (defn unregister-keymap!
49 | "Uses the unregister multi-method."
50 | [app keymap]
51 | (swap! app km/unregister-multi keymap))
52 |
53 | (defn- unregister-keymaps!
54 | "Unregister all keymaps in the plugin."
55 | [app keymaps]
56 | (doseq [km keymaps]
57 | (unregister-keymap! app km)))
58 |
59 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
60 | ;; Register plugin
61 |
62 | (defmulti register-plugin!
63 | "Registers the plugin when it is loaded. Returns
64 | nil if the plugin was already registered and not
65 | nil otherwise."
66 | (fn [_ plugin] (:type plugin)))
67 |
68 | (defmulti unregister-plugin!
69 | "Removes the plugin if it was registered. Returns
70 | nil if the plugin was not registered and not nil otherwise."
71 | (fn [_ plugin] (:type plugin)))
72 |
73 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
74 | ;; Load / Unload
75 |
76 | (defn load-plugin!
77 | "Receives the app atom and a symbol representing a plugin's
78 | name(space) and requires the ns. The plugin's vars init!,
79 | keymap and hooks are searched and processed accordingly if
80 | they exist."
81 | [app plugin-name & [reload]]
82 | (require [plugin-name :reload reload])
83 | (let [plugin-ns (the-ns plugin-name)
84 | {:keys [init! hooks keymaps] :as plugin}
85 | (->> (ns-resolve plugin-ns 'plugin) deref)]
86 | (assert plugin (str "Couldn't find a plugin definition in " plugin-name "."))
87 | (log/info "Loaded plugin " plugin-name)
88 | (when (register-plugin! app plugin)
89 | (log/info "Registered plugin " plugin-name)
90 | (when hooks
91 | (add-hooks! hooks plugin-name))
92 | (when init!
93 | (init! app))
94 | (when keymaps
95 | (register-keymaps! app keymaps)))))
96 |
97 | (defn unload-plugin!
98 | "Receives the app atom and a symbol representing a plugin's
99 | name(space). Unloads all hooks, removes all keymaps and calls
100 | the unload! function."
101 | [app plugin-name & [reload]]
102 | (let [plugin-ns (the-ns plugin-name)
103 | {:keys [unload! hooks keymaps] :as plugin}
104 | (->> (ns-resolve plugin-ns 'plugin) deref)]
105 | (assert plugin (str "Couldn't find a plugin definition in " plugin-name "."))
106 | (when (unregister-plugin! app plugin)
107 | (when hooks
108 | (remove-hooks! hooks plugin-name))
109 | (when unload!
110 | (unload! app))
111 | (when keymaps
112 | (unregister-keymaps! app keymaps)))))
113 |
114 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
115 | ;; Definition
116 |
117 | (defmacro defplugin
118 | "Defines a `#'plugin` var with the plugin's definition. All of
119 | the following values are optional when defining the plugin, except for
120 | the name.
121 |
122 | Usage:
123 |
124 | (defplugin 'plugin.name
125 | \"Some docstring for the plugin var.\"
126 | :type :global
127 | :keymaps [km1 km2 km3 ,,,]
128 | :hooks {target-var1 hook-fn1 ,,,}
129 | :init! init-fn!
130 | :unload! unload-fn!)
131 |
132 | `name` can be a symbol, a keyword or a string, all the rest of the
133 | fields are optional except for the `:type`:
134 | - `:type` should be one of `:global` or `:local`, this determines where
135 | the plugin is registered as loaded.
136 | - `:keymaps` vector that holds keymaps of different types
137 | which will be registered and unregisterd with the multimethods
138 | defined in `lab.core.keymap`.
139 | - `:hooks` map with vars as keys and fns (or vars holding fns)
140 | as values, which will be used as a hook using the robert-hooke lib.
141 | - `:init!` fn that takes a single argument which is the atom holding
142 | the whole app.
143 | - `:unload!` fn that takes a single argument which is the atom holding
144 | the whole app."
145 | [name & [docstr & opts :as options]]
146 | `(def ~'plugin
147 | ~(if (string? docstr) docstr (str "Plugin " name))
148 | (hash-map :name '~name ~@(if (string? docstr) opts options))))
149 |
--------------------------------------------------------------------------------
/src/clj/lab/core/trie.clj:
--------------------------------------------------------------------------------
1 | (ns lab.core.trie
2 | (:refer-clojure :exclude [contains?]))
3 |
4 | (defn contains?
5 | "Returns true if the value x exists in the specified trie."
6 | [trie x]
7 | (:terminal (get-in trie x) false))
8 |
9 | (defn prefix-matches
10 | "Returns a list of matches with the prefix specified in the trie specified."
11 | [trie prefix]
12 | (map :val (filter :val (tree-seq map? vals (get-in trie prefix)))))
13 |
14 | (defn add
15 | "Add a new terminal value."
16 | [trie x]
17 | (assoc-in trie x (merge (get-in trie x) {:val x :terminal true})))
18 |
19 | (defn trie
20 | "Builds a trie over the values in the specified seq coll."
21 | [coll]
22 | (reduce add {} coll))
23 |
--------------------------------------------------------------------------------
/src/clj/lab/lab.config:
--------------------------------------------------------------------------------
1 | (defconfig
2 | ;; Application name
3 | :name "Clojure Lab"
4 |
5 | :plugins-dir "plugins")
--------------------------------------------------------------------------------
/src/clj/lab/main.clj:
--------------------------------------------------------------------------------
1 | (ns lab.main
2 | "Entry point for the whole environment."
3 | (:require [lab.core :refer [init]])
4 | (:gen-class))
5 |
6 | (def app nil)
7 | ;;------------------------------
8 | (defn -main
9 | "Program startup function."
10 | [& [config-path & _]]
11 | (let [app (init config-path)]
12 | (alter-var-root #'app #(do %2) app)))
13 | ;;------------------------------
14 |
--------------------------------------------------------------------------------
/src/clj/lab/model/buffer.clj:
--------------------------------------------------------------------------------
1 | (ns lab.model.buffer
2 | "Provides a protocol interface for different text buffer
3 | implementations."
4 | (:require [clojure.zip :as zip]
5 | [net.cgrand.parsley :as parsley]
6 | [net.cgrand.parsley.tree :as tree]
7 | [lab.model.protocols :as p])
8 | (:import [net.cgrand.parsley.tree InnerNode Leaf]))
9 |
10 | (defn- node-children [^InnerNode x]
11 | (if (.c x)
12 | [(.a x) (.b x) (.c x)]
13 | [(.a x) (.b x)]))
14 |
15 | (defn- to-string
16 | ([b] (to-string b (StringBuffer.)))
17 | ([b ^StringBuffer s]
18 | (loop [z (zip/zipper (partial instance? InnerNode)
19 | node-children
20 | nil
21 | b)]
22 | (when-not (zip/end? z)
23 | (when-not (zip/branch? z)
24 | (.append s (.s ^Leaf (zip/node z))))
25 | (recur (zip/next z))))
26 | (.toString s)))
27 |
28 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
29 | ;;; Incremental Buffer implementation
30 |
31 | (defrecord IncrementalBuffer [buffer]
32 | p/Text
33 | (insert [this offset s]
34 | (assoc this :buffer (parsley/edit buffer offset 0 s)))
35 | (append [this s]
36 | (p/insert this (p/length this) s))
37 | (delete [this start end]
38 | (assoc this :buffer (parsley/edit buffer start (- end start) "")))
39 | (length [this]
40 | (-> buffer :buffer tree/len))
41 | (text [this]
42 | (-> buffer :buffer to-string))
43 | (substring [this start end]
44 | (-> buffer :buffer to-string (subs start end)))
45 |
46 | p/Parsable
47 | (parse-tree [this]
48 | (parsley/parse-tree buffer)))
49 |
50 | (defn- build-incremental-buffer
51 | [lang]
52 | (let [{:keys [options grammar]}
53 | lang
54 | parser (apply parsley/parser options grammar)]
55 | (parsley/incremental-buffer parser)))
56 |
57 | (def ^:private memoized-build-incremental-buffer
58 | (memoize build-incremental-buffer))
59 |
60 | (defn incremental-buffer
61 | "Returns an incremental buffer whose content will be parsed using
62 | the parsing information from the language provided."
63 | ([lang]
64 | (incremental-buffer lang ""))
65 | ([lang s]
66 | (-> (IncrementalBuffer. (memoized-build-incremental-buffer lang))
67 | (p/insert 0 s))))
68 |
69 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
70 | ;;; StringBuffer implementation
71 |
72 | (extend-type StringBuffer
73 | p/Text
74 | (insert [this offset s]
75 | (.insert this ^int offset ^String s))
76 | (append [this s]
77 | (.append this ^String s))
78 | (delete [this start end]
79 | (.delete this ^int start ^int end))
80 | (length [this]
81 | (.length this))
82 | (text [this]
83 | (.toString this))
84 | (substring [this start end]
85 | (.substring this start end)))
86 |
87 | (defn string-buffer
88 | "Return a native mutable java StringBuffer instance."
89 | ([]
90 | (string-buffer ""))
91 | ([^String s]
92 | (StringBuffer. s)))
93 |
--------------------------------------------------------------------------------
/src/clj/lab/model/history.clj:
--------------------------------------------------------------------------------
1 | (ns lab.model.history
2 | "API to create and manipulate a history of operations."
3 | (:refer-clojure :exclude [empty empty?])
4 | (:require [clojure.core :as core]))
5 |
6 | (defprotocol Undoable
7 | (redo [this] "Returns a function that redoes some operation.")
8 | (undo [this] "Returns a function that undoes some operation."))
9 |
10 | (def ^{:dynamic true :private true} *save-in-history*
11 | "Indicates if record-operations function should add
12 | operations to the history. Should be set to false when
13 | grouping operations to save in the history."
14 | true)
15 |
16 | (defmacro with-no-history
17 | "Disable saving to history for the operations done in
18 | the &body."
19 | [& body]
20 | `(binding [*save-in-history* false]
21 | ~@body))
22 |
23 | (defmacro with-history
24 | "By default operations that modify a document are
25 | saved in the history, but in case saving to the history
26 | was disabled upstream, you might like to make
27 | sure that operations are being saved."
28 | [& body]
29 | `(binding [*save-in-history* true]
30 | ~@body))
31 |
32 | (defn history
33 | "Creates a history that mantains two stacks (past and future)."
34 | ([]
35 | (history [] []))
36 | ([past]
37 | (history past []))
38 | ([past fut]
39 | {:past past
40 | :present nil
41 | :future fut}))
42 |
43 | (defn current
44 | "Returns the last operation added."
45 | [{:keys [present] :as h}]
46 | present)
47 |
48 | (defn forward
49 | "Moves an operation from the future to the past."
50 | [{:keys [past present future] :as h}]
51 | (if (or present (peek future))
52 | (assoc h
53 | :past (if present (conj past present) past)
54 | :present (peek future)
55 | :future (or (and (peek future)
56 | (pop future))
57 | []))
58 | h))
59 |
60 | (defn fast-forward
61 | "Moves all operations from the future to the past."
62 | [{:keys [future present past] :as h}]
63 | (assoc h
64 | :past (-> (if present (conj past present) past)
65 | (into (reverse future)))
66 | :present nil
67 | :future []))
68 |
69 | (defn rewind
70 | "Moves an operation from the past to the future."
71 | [{:keys [future present past] :as h}]
72 | (if (or present (peek past))
73 | (assoc h
74 | :past (or (and (peek past)
75 | (pop past))
76 | [])
77 | :present (peek past)
78 | :future (if present (conj future present) future))
79 | h))
80 |
81 | (defn add
82 | "Adds an operation to the past of this history removing
83 | creating a new timeline (removing all operations in the
84 | current future)."
85 | [{:keys [future present past] :as h} op]
86 | (if *save-in-history*
87 | (assoc h
88 | :past (if present (conj past present) past)
89 | :present op
90 | :future [])
91 | h))
92 |
93 | (defn update
94 | "Takes a function that receives the history's present
95 | value and additional arguments."
96 | [h f & args]
97 | (apply update-in h [:present] f args))
98 |
99 | (defn empty
100 | "Removes all operations from the history."
101 | [_]
102 | (history))
103 |
104 | (defn empty?
105 | "Returns true if the history has no past or present operations."
106 | [{:keys [future present past] :as h}]
107 | (and (core/empty? past)
108 | (nil? present)
109 | (core/empty? future)))
110 |
--------------------------------------------------------------------------------
/src/clj/lab/model/protocols.clj:
--------------------------------------------------------------------------------
1 | (ns lab.model.protocols)
2 |
3 | (defprotocol Text
4 | (insert [this offset s] "Inserts s in offset.")
5 | (append [this s] "Appends s to the current text.")
6 | (delete [this start end] "Delete the contents of the buffer from positions start to end.")
7 | (length [this] "Returns the length of the buffer.")
8 | (text [this] "Returns the contents of the buffer as a string.")
9 | (substring [this start end] "Returns the substring from start to end offsets."))
10 |
11 | (defprotocol Parsable
12 | (parse-tree [this] "Returns a parse tree with each node being {:tag :tag-kw :content [node*]}"))
13 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/clojure/macroexpand.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.clojure.macroexpand
2 | (:require [clojure.zip :as zip]
3 | [lab.core [plugin :refer [defplugin]]
4 | [keymap :as km]
5 | [lang :as lang]]
6 | [lab.model.protocols :as model]
7 | [lab.ui.core :as ui]
8 | [lab.plugin.clojure.nrepl :as nrepl]))
9 |
10 | (defn- current-form
11 | "Takes a text editor and returns a string with the contents
12 | of the inner-most form found in the current position."
13 | [editor]
14 | (let [doc (ui/attr editor :doc)
15 | root (lang/code-zip (lang/parse-tree @doc))
16 | pos (ui/caret-position editor)
17 | [loc i] (lang/location root pos)
18 | delim-loc (lang/select-location loc zip/up #(-> % lang/location-tag (= :list)))]
19 | (when-let [[s e] (and delim-loc (lang/limits delim-loc))]
20 | (model/substring editor s e))))
21 |
22 | (defn- show-popup
23 | [app editor expansion]
24 | (let [location (ui/caret-location editor)
25 | popup (ui/init [:pop-up-menu {:size [500 200]
26 | :location location
27 | :source editor
28 | :border :none}
29 | [:scroll
30 | [:panel {:layout :border}
31 | [:text-editor {:text expansion
32 | :read-only true
33 | :line-highlight-color [0 0 0 0]}]]]])]
34 | (-> popup
35 | (ui/update :text-editor ui/caret-position 0)
36 | (ui/attr :visible true)
37 | (ui/update :text-editor ui/focus)
38 | (ui/apply-stylesheet (:styles @app)))))
39 |
40 | (defn- macroexpansion
41 | "Shows the current form's macroexpansion in a popup."
42 | [{:keys [app source] :as e}]
43 | (when-let [form (current-form source)]
44 | (let [code (when form `(macroexpand '~(read-string form)))
45 | expansion (nrepl/eval-and-get-value app (str code))
46 | result (with-out-str (clojure.pprint/pprint expansion))]
47 | (show-popup app source result))))
48 |
49 | (def ^:private keymaps
50 | [(km/keymap "Macroexpand"
51 | :local
52 | {:keystroke "ctrl alt enter" :fn ::macroexpansion :name "Inline macroexpansion"})])
53 |
54 | (defplugin ::plugin
55 | :type :local
56 | :keymaps keymaps)
57 |
58 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/code_outline.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.code-outline
2 | (:require [clojure.zip :as zip]
3 | [lab.core :as lab]
4 | [lab.core.lang :as lang]
5 | [lab.core.plugin :as plugin]
6 | [lab.core.keymap :as km]
7 | [lab.util :as util]
8 | [lab.ui.core :as ui]
9 | [lab.ui.templates :as tplts]
10 | [lab.model.document :as doc]
11 | [lab.core.main :refer [current-text-editor]]))
12 |
13 | (defn- go-to-definition [ui line-number]
14 | (let [editor (current-text-editor @ui)
15 | id (ui/attr editor :id)]
16 | (when id
17 | (ui/update! ui (ui/id= id)
18 | #(-> %
19 | (ui/caret-position line-number)
20 | ui/focus)))))
21 |
22 | (defn- go-to-definition-enter
23 | "Handles the enter press in a tree node positioning the
24 | caret in the definition associated with the tree node."
25 | [{:keys [app source description event] :as e}]
26 | (when (and (= :pressed event) (= :enter description))
27 | (let [ui (:ui @app)
28 | info (ui/attr source :info)]
29 | (go-to-definition ui (:offset info)))))
30 |
31 | (defn- go-to-definition-click
32 | "Handles the click in a tree node positioning the
33 | caret in the definition associated with the tree node."
34 | [e]
35 | (when (= 2 (:click-count e))
36 | (let [ui (-> e :app deref :ui)
37 | node (:source e)
38 | info (ui/attr node :info)]
39 | (go-to-definition ui (:offset info)))))
40 |
41 | (defn- def->tree-node
42 | [app def-info]
43 | [:tree-node {:leaf true
44 | :item (:name def-info)
45 | :info def-info
46 | :listen [:key ::go-to-definition-enter
47 | :click ::go-to-definition-click]}])
48 |
49 | (defn- update-outline-tree!
50 | "Updates the outline using the document provided
51 | or the current document if non is specified."
52 | ([app]
53 | (update-outline-tree! app (lab/current-document app)))
54 | ([app doc]
55 | (let [ui (:ui app)
56 | outline (ui/find @ui :#outline-tree)]
57 | (when outline
58 | (if-not doc
59 | (ui/action (ui/update! ui :#outline-tree ui/remove-all))
60 | (let [lang (:lang @doc)
61 | definitions (:definitions lang)
62 | parse-tree (lang/parse-tree @doc nil)
63 | defs (and definitions (definitions parse-tree))
64 | root (into [:tree-node {:item (:name @doc)}]
65 | (map (partial #'def->tree-node app) defs))]
66 | (ui/action
67 | (ui/update! ui :#outline-tree
68 | #(-> % ui/remove-all (ui/add root))))))))))
69 |
70 | (defn- outline-tree
71 | "Creates a new tab that contains a tree with id :#outline-tree."
72 | [app]
73 | (-> (tplts/tab "outline-tab")
74 | (ui/update :tab
75 | ui/update-attr :header
76 | ui/update :label ui/attr :text "Outline")
77 | (ui/add [:scroll [:tree {:id "outline-tree"}]])
78 | (ui/apply-stylesheet (:styles @app))))
79 |
80 | (defn- create-outline-tree! [e]
81 | (let [app (:app e)
82 | ui (:ui @app)
83 | outline (ui/find @ui :#outline-tree)]
84 | (if-not outline
85 | (let [split (ui/find @ui :#center-right)]
86 | (ui/update! ui :#right ui/add (outline-tree app))
87 | (when-not (ui/attr split :divider-location-right)
88 | (ui/update! ui :#center-right ui/attr :divider-location-right 150))
89 | (update-outline-tree! @app))
90 | (when-let [tab (ui/find @ui :#outline-tab)]
91 | (ui/update! ui :#right ui/remove tab)))))
92 |
93 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
94 | ;; Hooks
95 |
96 | (defn- switch-document-hook
97 | "Hook for #'lab.core/switch-document:
98 | Updates the outline tree based on the document's lang
99 | and content"
100 | [f app doc]
101 | (let [app (f app doc)]
102 | (future (#'update-outline-tree! app doc))
103 | app))
104 |
105 | (defn- text-editor-hook [f doc]
106 | (let [editor (f doc)
107 | g (fn [e] (#'update-outline-tree! @(:app e) doc))
108 | ch (util/timeout-channel 500 g)]
109 | (-> editor
110 | (ui/listen :insert ch)
111 | (ui/listen :delete ch))))
112 |
113 | (def ^:private hooks
114 | {#'lab.core/switch-document #'switch-document-hook
115 | #'lab.core.main/text-editor-view #'text-editor-hook})
116 |
117 | (def ^:private keymaps
118 | [(km/keymap "Code Outline"
119 | :global
120 | {:category "View" :name "Outline" :fn #'create-outline-tree! :keystroke "alt O"})])
121 |
122 | (plugin/defplugin lab.plugin.code-outline
123 | :type :global
124 | :hooks hooks
125 | :keymaps keymaps)
126 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/editor/autocomplete.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.editor.autocomplete
2 | (:require [clojure.zip :as zip]
3 | [lab.core [plugin :as plugin]
4 | [keymap :as km]
5 | [lang :as lang]
6 | [trie :as trie]]
7 | [lab.model [protocols :as model]
8 | [document :as doc]]
9 | [lab.ui [core :as ui]
10 | [templates :as tplts]]
11 | [lab.plugin.clojure.nrepl :as nrepl]))
12 |
13 | (defn token-location-at-caret
14 | "Takes an editor and finds the token immediately after
15 | the current caret position."
16 | [editor]
17 | (let [root (-> @(ui/attr editor :doc)
18 | lang/parse-tree
19 | lang/code-zip)
20 | pos (ui/caret-position editor)
21 | [loc i] (lang/location root pos)
22 | tag (lang/location-tag loc)
23 | prev (or (and (= :symbol tag) ; at a symbol
24 | (zip/up loc))
25 | (zip/left loc) ; at a closing delimiter
26 | (-> loc zip/up zip/left)) ; at the end of a whitespace
27 | tag (lang/location-tag prev)]
28 | (when (and prev
29 | (or (= :symbol tag)
30 | (and (not= :symbol tag) (= pos i))))
31 | prev)))
32 |
33 | (defn- select-autocomplete
34 | "Takes an event whose source is a node from the autocompletion
35 | tree list. Identifies the selected option in the autocomplete
36 | popup menu and replaces the token at the caret position with
37 | the selection."
38 | [{:keys [source] :as e}]
39 | (let [txt (ui/attr source :item)
40 | {:keys [editor popup]}
41 | (ui/stuff source)
42 | loc (token-location-at-caret editor)
43 | [start end]
44 | (lang/limits loc)
45 | ws? (lang/whitespace? loc)
46 | offset (if ws?
47 | (ui/caret-position editor)
48 | start)]
49 | (when (not ws?)
50 | (model/delete editor start end))
51 | (ui/attr popup :visible false)
52 | (-> editor
53 | (model/insert offset txt)
54 | (ui/caret-position (+ offset (count txt)))
55 | ui/focus)))
56 |
57 | (defn- matches-nodes [editor popup matches]
58 | (let [km (km/keymap "Autocomplete" :local
59 | {:fn ::select-autocomplete :keystroke "enter"})
60 | stuff {:editor editor :popup popup}]
61 | (-> [:tree-node {:item :root}]
62 | (into (map (fn [sym-name]
63 | [:tree-node {:item sym-name
64 | :leaf true
65 | :stuff stuff
66 | :listen [:key km]}])
67 | matches)))))
68 |
69 | (defn popup-menu
70 | [editor matches]
71 | (let [location (ui/caret-location editor)
72 | popup (ui/init
73 | [:pop-up-menu {:location location
74 | :source editor
75 | :border :none}
76 | [:scroll {:size [250 100]}
77 | [:tree {:hide-root true}]]])
78 | root (matches-nodes editor popup matches)]
79 | (-> popup
80 | (ui/update :tree ui/add root)
81 | (ui/attr :visible true)
82 | (ui/update :tree ui/focus))))
83 |
84 | (defn- completion-tokens
85 | "Gets the auto-completion functions from the current document's
86 | lang and runs them accumulating theirs results in a set.
87 | Returns nil if there's no token in the current caret position."
88 | [{:keys [app source] :as e}]
89 | (let [lang (:lang @(ui/attr source :doc))
90 | fns (:autocomplete lang)]
91 | (when-let [loc (token-location-at-caret source)]
92 | (-> (reduce into #{} (map #(% e) fns))
93 | trie/trie
94 | (trie/prefix-matches (-> loc zip/down zip/node))))))
95 |
96 | ;;;;;;;;;;;;;;;;;;;;;;;;
97 | ;; Plugin definition
98 |
99 | (defn- autocomplete
100 | [{:keys [app source] :as e}]
101 | (when-let [symbols (completion-tokens e)]
102 | (-> (popup-menu source (sort symbols))
103 | (ui/apply-stylesheet (:styles @app)))))
104 |
105 | (def ^:private keymaps
106 | [(km/keymap "Autocomplete"
107 | :local
108 | {:fn ::autocomplete :keystroke "ctrl space" :name "Autocomplete"})])
109 |
110 | (plugin/defplugin lab.plugin.editor.autocomplete
111 | :type :local
112 | :keymaps keymaps)
113 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/editor/delimiter_matching.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.editor.delimiter-matching
2 | (:require [clojure.core.async :as async]
3 | [lab.ui.core :as ui]
4 | [lab.model.document :as doc]
5 | [lab.core [plugin :as plugin]
6 | [lang :as lang]
7 | [main :as main]]))
8 |
9 | (defn- check-for-delimiters [e highlights]
10 | (let [editor (:source e)
11 | doc (ui/attr editor :doc)
12 | lang (:lang @doc)
13 | pos (:position e)
14 | delimiter-match (:delimiter-match lang)
15 | add-hl #(ui/add-highlight editor % (inc %) 0x888888)]
16 | (when delimiter-match
17 | (ui/action
18 | (doseq [x @highlights]
19 | (swap! highlights disj)
20 | (ui/remove-highlight editor x))
21 | (swap! highlights into (mapv add-hl (delimiter-match @doc pos)))))))
22 |
23 | (defn- find-matching-delimiter []
24 | (let [ch (async/chan)
25 | highlights (atom #{})]
26 | (async/go-loop []
27 | (when-let [e (async/ editor
35 | (ui/update-attr :stuff assoc ::listener ch)
36 | (ui/listen :caret ch))))
37 |
38 | (defn- text-editor-unload [editor]
39 | (let [ch (::listener (ui/stuff editor))]
40 | (-> editor
41 | (ui/update-attr :stuff dissoc ::listener)
42 | (ui/ignore :caret ch))))
43 |
44 | (defn init! [app]
45 | (let [ui (:ui @app)
46 | editor (main/current-text-editor @ui)
47 | id (ui/attr editor :id)]
48 | (ui/update! ui (ui/id= id) text-editor-init)))
49 |
50 | (defn unload! [app]
51 | (let [ui (:ui @app)
52 | id (ui/attr (main/current-text-editor @ui) :id)]
53 | (ui/update! ui (ui/id= id) text-editor-unload)))
54 |
55 | (plugin/defplugin lab.plugin.editor.delimiter-matching
56 | :type :local
57 | :init! init!
58 | :unload! unload!)
59 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/editor/go_to.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.editor.go-to
2 | (:require [lab.core [keymap :as km]
3 | [plugin :refer [defplugin]]
4 | [main :refer [current-text-editor]]]
5 | [lab.model.protocols :as model]
6 | [lab.ui.core :as ui]))
7 |
8 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9 | ;;; View
10 |
11 | (defn view [owner dialog]
12 | (let [ok-btn (ui/init [:button {:id "ok"
13 | :text "Ok"
14 | :stuff {:dialog dialog}
15 | :listen [:click ::goto-line-ok]}])]
16 | [:dialog {:owner owner
17 | :icons ["right-icon.png"]
18 | :title "Go to Line"
19 | :size [300 85]
20 | :modal true
21 | :default-button ok-btn}
22 | [:panel {:layout [:box :page]}
23 | [:text-field {:border :none}]
24 | [:panel {:layout :flow}
25 | ok-btn
26 | [:button {:id "cancel"
27 | :text "Cancel"
28 | :listen [:click ::goto-line-cancel]}]]]]))
29 |
30 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
31 | ;;; Go to line
32 |
33 | (defn- goto-line-ok
34 | [{:keys [source] :as e}]
35 | (let [dialog (:dialog (ui/stuff source))
36 | txt (model/text (ui/find @dialog :text-field))]
37 | (when (re-matches #"\d*" txt)
38 | (ui/update! dialog [] ui/attr :result :ok)
39 | (ui/update! dialog [] ui/attr :visible false))))
40 |
41 | (defn- goto-line-cancel
42 | [{:keys [source] :as e}]
43 | (let [dialog (:dialog (ui/stuff source))]
44 | (ui/update! dialog [] ui/attr :result :cancel)
45 | (ui/update! dialog [] ui/attr :visible false)))
46 |
47 | (defn- goto-line!
48 | [e]
49 | (let [app (:app e)
50 | ui (:ui @app)
51 | editor (current-text-editor @ui)
52 | dialog (atom nil)]
53 | (when editor
54 | (-> dialog
55 | (reset! (ui/init (view @ui dialog)))
56 | (ui/attr :visible true))
57 | (when (= :ok (ui/attr @dialog :result))
58 | (ui/goto-line editor (-> @dialog (ui/find :text-field) model/text read-string))))))
59 |
60 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
61 | ;;; Plugin Definition
62 |
63 | (def ^:private keymaps
64 | [(km/keymap "Go to line"
65 | :global
66 | {:category "Edit", :name "Go to Line" :fn ::goto-line! :keystroke "ctrl g"})])
67 |
68 | (defplugin lab.plugin.editor.go-to
69 | "Implements the functionality 'go to line of current documet'."
70 | :type :global
71 | :keymaps keymaps)
72 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/editor/rainbow_delimiters.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.editor.rainbow-delimiters
2 | (:require [clojure.zip :as zip]
3 | [lab.ui.core :as ui]
4 | [lab.util :refer [timeout-channel find-limits]]
5 | [lab.model.document :as doc]
6 | [lab.model.protocols :as model]
7 | [lab.core [plugin :as plugin]
8 | [lang :as lang]
9 | [keymap :as km]
10 | [main :as main]]))
11 |
12 | (def rainbow-styles
13 | {1 {:color 0xFF2244}
14 | 2 {:color 0xFF7F00}
15 | 3 {:color 0xFFFF00}
16 | 4 {:color 0x00FF00}
17 | 5 {:color 0x8BFFFF}
18 | 6 {:color 0x0000FF}
19 | 7 {:color 0x8B00FF}})
20 |
21 | (def depths-styles rainbow-styles)
22 | (def depths-count (count depths-styles))
23 |
24 | (def all-delimiters "[\\(\\){}\\[\\]]")
25 | (def opening? #{\( \{ \[})
26 |
27 | (def ignore? #{:net.cgrand.parsley/unfinished
28 | :net.cgrand.parsley/unexpected
29 | :string :comment :char :regex})
30 |
31 | (defn collection? [loc]
32 | (#{:list :vector :map :set :fn} (lang/location-tag loc)))
33 |
34 | (defn- depth [loc]
35 | (loop [loc loc, d 0]
36 | (if loc
37 | (recur (zip/up loc) (if (collection? loc) (inc d) d))
38 | d)))
39 |
40 | (defn- delims [loc]
41 | (let [offset (lang/offset loc)
42 | down (zip/down loc)
43 | len (lang/location-length loc)
44 | slen (-> down zip/leftmost lang/location-length)
45 | elen (-> down zip/rightmost lang/location-length)
46 | d (-> (depth loc) dec (mod depths-count) inc)]
47 | [[offset slen d]
48 | [(+ offset len (- elen)) elen d]]))
49 |
50 | (defn- delimiters-tokens [root]
51 | (let [colls (lang/search root collection?)]
52 | (mapcat delims colls)))
53 |
54 | (defn- color-delimiters! [editor & [styles]]
55 | (let [doc (ui/attr editor :doc)
56 | txt (model/text editor)
57 | root (lang/code-zip (lang/parse-tree @doc))
58 | tokens (delimiters-tokens root)
59 | styles (or styles (-> @doc :lang :styles))]
60 | (ui/action
61 | (when (= txt (model/text editor))
62 | (ui/apply-style editor tokens styles))))
63 | editor)
64 |
65 | (defn- text-editor-change! [e]
66 | (let [editor (:source e)]
67 | (color-delimiters! editor depths-styles)))
68 |
69 | (defn- text-editor-init [editor]
70 | (let [ch (timeout-channel 500 #'text-editor-change!)]
71 | (-> editor
72 | (color-delimiters! depths-styles)
73 | (ui/update-attr :stuff assoc ::listener ch)
74 | (ui/listen :insert ch)
75 | (ui/listen :delete ch))))
76 |
77 | (defn- text-editor-unload [editor]
78 | (let [ch (::listener (ui/stuff editor))]
79 | (-> editor
80 | (ui/update-attr :stuff dissoc ::listener)
81 | (ui/ignore :insert ch)
82 | (ui/ignore :delete ch)
83 | color-delimiters!)))
84 |
85 | (defn- toogle-rainbow
86 | [{:keys [source app] :as e}]
87 | (let [ui (:ui @app)
88 | id (ui/attr source :id)]
89 | (if (-> source ui/stuff ::listener)
90 | (ui/update! ui (ui/id= id) text-editor-unload)
91 | (ui/update! ui (ui/id= id) text-editor-init))))
92 |
93 | (def ^:private keymap
94 | (km/keymap "Rainbow Delimiters" :local
95 | {:fn ::toogle-rainbow :keystroke "ctrl p" :name "Toogle Rainbow Delimiters"}))
96 |
97 | (defn init! [app]
98 | (let [ui (:ui @app)
99 | editor (main/current-text-editor @ui)
100 | id (ui/attr editor :id)]
101 | (ui/update! ui (ui/id= id) #(-> % text-editor-init (ui/listen :key keymap)))))
102 |
103 | (defn unload! [app]
104 | (let [ui (:ui @app)
105 | id (ui/attr (main/current-text-editor @ui) :id)]
106 | (ui/update! ui (ui/id= id) #(-> % text-editor-unload (ui/ignore :key keymap)))))
107 |
108 | (plugin/defplugin lab.plugin.editor.rainbow-delimiters
109 | :type :local
110 | :init! init!
111 | :unload! unload!)
112 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/editor/syntax_highlighting.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.editor.syntax-highlighting
2 | (:require [clojure.core.async :as async]
3 | [lab.util :refer [timeout-channel]]
4 | [lab.ui.core :as ui]
5 | [lab.model.document :as doc]
6 | [lab.core [plugin :as plugin]
7 | [lang :as lang]
8 | [main :as main]]))
9 |
10 | (defn highlight!
11 | "Takes the editor component and an optional argument
12 | that indicates if the highlight should be incremental
13 | or not.
14 |
15 | If it's incremental only the highlight modified since the
16 | last parse tree generation are update, otherwise all tokens
17 | are applied their highlight."
18 | [editor & [incremental]]
19 | (let [doc (ui/attr editor :doc)
20 | node-group (and incremental (gensym "group-"))
21 | lang (:lang @doc)
22 | styles (:styles lang)
23 | old-text (doc/text editor)
24 | parse-tree (lang/parse-tree @doc node-group)
25 | tokens (lang/tokens parse-tree node-group)
26 | ;; If there are no tokens for this group then take the group from the root node.
27 | tokens (if (empty? tokens)
28 | (lang/tokens parse-tree (lang/node-group parse-tree))
29 | tokens)]
30 | (ui/action
31 | ;; Before applying the styles check that the
32 | ;; text is still the same, otherwise some tokens
33 | ;; get messed up.
34 | (when (= (doc/text editor) old-text)
35 | (ui/apply-style editor tokens styles))))
36 | editor)
37 |
38 | (defn- text-editor-change! [e]
39 | (if-not (= :change (:type e))
40 | (highlight! (:source e) true)))
41 |
42 | (defn- text-editor-init [editor]
43 | (let [hl-ch (timeout-channel 250 #'text-editor-change!)]
44 | (-> editor
45 | highlight!
46 | (ui/update-attr :stuff assoc ::listener hl-ch)
47 | (ui/listen :insert hl-ch)
48 | (ui/listen :delete hl-ch))))
49 |
50 | (defn- text-editor-unload [editor]
51 | (let [hl-ch (::listener (ui/stuff editor))]
52 | (-> editor
53 | (ui/update-attr :stuff dissoc ::listener)
54 | (ui/ignore :insert hl-ch)
55 | (ui/ignore :delete hl-ch))))
56 |
57 | (defn init! [app]
58 | (let [ui (:ui @app)
59 | editor (main/current-text-editor @ui)
60 | id (ui/attr editor :id)]
61 | (ui/update! ui (ui/id= id) text-editor-init)))
62 |
63 | (defn unload! [app]
64 | (let [ui (:ui @app)
65 | id (ui/attr (main/current-text-editor @ui) :id)]
66 | (ui/update! ui (ui/id= id) text-editor-unload)))
67 |
68 | (plugin/defplugin lab.plugin.editor.syntax-highlighting
69 | :type :local
70 | :init! init!
71 | :unload! unload!)
72 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/editor/undo_redo.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.editor.undo-redo
2 | (:require [lab.core [main :refer [current-text-editor]]
3 | [keymap :as km]
4 | [plugin :refer [defplugin]]]
5 | [lab.model.document :as doc]
6 | [lab.ui.core :as ui]))
7 |
8 | (defn undo-redo! [e f]
9 | (let [app (:app e)
10 | ui (:ui @app)
11 | editor (current-text-editor @ui)]
12 | (when editor
13 | (let [id (ui/attr editor :id)
14 | doc (ui/attr editor :doc)
15 | hist (:history @doc)]
16 | (swap! doc f)
17 | ;; TODO: Fix this abominable scheme for undo/redo
18 | (doc/no-op
19 | (let [[editor hist] (f editor hist)]
20 | (ui/update! ui (ui/id= id) (constantly editor))))))))
21 |
22 | (defn redo! [e]
23 | (undo-redo! e doc/redo))
24 |
25 | (defn undo! [e]
26 | (undo-redo! e doc/undo))
27 |
28 | (def ^:private keymaps
29 | [(km/keymap "Undo/Redo"
30 | :global
31 | {:category "Edit", :name "Undo", :fn ::undo!, :keystroke "ctrl z"}
32 | {:category "Edit", :name "Redo", :fn ::redo!, :keystroke "ctrl y"})])
33 |
34 | (defplugin lab.core.main
35 | "Provides the global commands for undo and redo operations."
36 | :type :global
37 | :keymaps keymaps)
38 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/helper.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.helper
2 | (:require [lab.core [plugin :refer [defplugin]]
3 | [keymap :as km]]
4 | [lab.ui.core :as ui]))
5 |
6 | (defn- info-view
7 | [owner]
8 | [:dialog {:owner owner
9 | :modal true
10 | :size [600 500]
11 | :resizable false
12 | :background [0 0 0 0]
13 | :undecorated true}
14 | [:scroll {:border [:line [0 0 0 0x44] 2]
15 | :transparent true
16 | :vertical-increment 16}
17 | [:panel {:layout [:box :page]
18 | :padding 5
19 | :background [0 0 0]}]]])
20 |
21 | (defn- section-label
22 | [txt]
23 | [:panel {:layout [:box :line]
24 | :transparent true}
25 | [:label {:text txt
26 | :color 0xFFFFFF
27 | :font [:size 16 :style :bold]}]
28 | [:panel {:transparent true}]])
29 |
30 | (defn- command-label
31 | [{:keys [name category keystroke]}]
32 | [:panel {:layout [:box :line]
33 | :transparent true}
34 | [:label {:text (str (or (and category (str category " - ")))
35 | name)
36 | :color 0xFFFFFF
37 | :font [:size 14]}]
38 | [:panel {:transparent true
39 | :border [:line 0x333333 [0 0 1 0]]
40 | :padding [0 10]}]
41 | [:label {:text (.toUpperCase ^String (str keystroke))
42 | ;; :width 100
43 | :color 0xFFFFFF
44 | :font [:size 14 :style :bold]}]])
45 |
46 | (defn- default-local-keymap
47 | [x]
48 | (->> (ui/listeners x :key)
49 | (filter map?)
50 | first))
51 |
52 | (defmulti local-keymap
53 | "Takes a UI component and returns its local keymap."
54 | :tag)
55 |
56 | (defmethod local-keymap :default
57 | [x]
58 | (default-local-keymap x))
59 |
60 | (defmethod local-keymap :text-editor
61 | [x]
62 | (if-let [doc (ui/attr x :doc)]
63 | (km/append (:keymap @doc) (default-local-keymap x))
64 | (default-local-keymap x)))
65 |
66 | (defn- commands-list
67 | [app source]
68 | (let [global (:keymap @app)
69 | local (local-keymap source)]
70 | (reduce
71 | (fn [labels [k cmds]]
72 | (reduce
73 | (fn [labels cmd]
74 | (if (:keystroke cmd)
75 | (conj labels (command-label cmd))
76 | labels))
77 | (conj labels (section-label (str k)))
78 | (sort-by :category cmds)))
79 | []
80 | (mapcat km/commands [local global]))))
81 |
82 | (defn- help-info
83 | [{:keys [app source] :as e}]
84 | (let [ui (:ui @app)]
85 | (-> (info-view @ui)
86 | ui/init
87 | (ui/update :panel ui/add-all (commands-list app source))
88 | (ui/attr :visible true))))
89 |
90 | (def ^:private keymaps
91 | [(km/keymap "Contextual Help"
92 | :global
93 | {:category "Help" :name "Show Info" :fn ::help-info :keystroke "f1"})])
94 |
95 | (defplugin (ns-name *ns*)
96 | :type :global
97 | :keymaps keymaps)
98 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/markdown/lang.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.markdown.lang
2 | "Markdown language specification."
3 | (:require [clojure.zip :as zip]
4 | [lab.core :as lab]
5 | [lab.core [plugin :as plugin]
6 | [lang :as lang]
7 | [keymap :as km]]
8 | [lab.model.protocols :as model]
9 | [lab.ui.core :as ui]
10 | [lab.model.document :as doc]))
11 |
12 | (defn loc->def [loc]
13 | {:offset (lang/offset loc)
14 | :name (-> loc zip/down zip/node)})
15 |
16 | (defn defs [root]
17 | (let [loc (lang/code-zip root)]
18 | (loop [loc (zip/down loc), defs []]
19 | (if (nil? loc)
20 | defs
21 | (recur (zip/right loc)
22 | (if (= :title (-> loc zip/node :tag))
23 | (conj defs (loc->def loc))
24 | defs))))))
25 |
26 | (def grammar [:expr- #{:title :list :blockquote
27 | :paragraph :element}
28 | :element- #{:strong :em :link :html :code :text}
29 | :text #"([^\s<>#\-+=\*_\[`\d]|\d+(?!\d*\.))\S*"
30 | :paragraph [#"(?<=\n)[^-#]" :element* "\n"]
31 | :title #{#"#{1,6}.+\n"
32 | #"[-=][-=^ ]*\n"}
33 | :strong #{#"\*\*(?"
41 | :code #{#"(?: {4} *|\t+[^-])(?! |[-\+\*]|\d+\.)(?.*"
45 | :whitespace #"[\r\n]+"])
46 |
47 | (def ^:private styles
48 | {:title {:color 0xC800C8}
49 | :strong {:color 0x00FF00}
50 | :em {:color 0x00FFFF}
51 | :list {:color 0xFF6666}
52 | :link {:color 0xFFE64D}
53 | :html {:color 0x64DCB3}
54 | :code {:color 0x9566E5}
55 | :blockquote {:color 0xAAAAAA}
56 | :default {:color 0xFFFFFF}
57 | :net.cgrand.parsley/unfinished {:color 0xFF1111 :italic true}
58 | :net.cgrand.parsley/unexpected {:color 0xFF1111 :italic true}})
59 |
60 | (defn- resolve-style
61 | "Used by the syntax highlighting plugin. Takes a tag keyword
62 | and returns the style defined for that tag. If no style exists
63 | return the default style."
64 | [tag]
65 | (styles tag (:default styles)))
66 |
67 | (defn- wrap-in
68 | "Wraps the current selection in the delim."
69 | ([delim e]
70 | (wrap-in delim delim e))
71 | ([delim-begin delim-end {:keys [app source] :as e}]
72 | (let [ui (:ui @app)
73 | [start end] (ui/selection source)
74 | txt (model/substring source start end)]
75 | (ui/action
76 | (doc/bundle-operations
77 | (when (not= start end)
78 | (model/delete source start end))
79 | (model/insert source start (str delim-begin txt delim-end)))
80 | (ui/caret-position source (- (ui/caret-position source) (count delim-end)))))))
81 |
82 | (def ^:private keymap
83 | (km/keymap "Markdown"
84 | :lang :markdown
85 | {:fn (partial #'wrap-in "`") :keystroke "ctrl k" :name "Code Snippet"}
86 | {:fn (partial #'wrap-in "**") :keystroke "ctrl b" :name "Bold"}
87 | {:fn (partial #'wrap-in "*") :keystroke "ctrl i" :name "Italic"}
88 | {:fn (partial #'wrap-in " " " ") :keystroke "alt k" :name "Keystroke"}
89 | {:fn (partial #'wrap-in "[" "]( )") :keystroke "alt l" :name "Link"}))
90 |
91 | (def markdown
92 | {:id :markdown
93 | :name "Markdown"
94 | :options {:main :expr*
95 | :root-tag ::root
96 | :space :whitespace*
97 | :make-node lang/make-node}
98 | :grammar grammar
99 | :definitions defs
100 | :rank (partial lang/file-extension? "md")
101 | :styles #'resolve-style
102 | :keymap keymap})
103 |
104 | (defn init! [app]
105 | (swap! app assoc-in [:langs (:id markdown)] markdown))
106 |
107 | (plugin/defplugin lab.plugin.markdown.lang
108 | :type :global
109 | :init! init!)
110 |
111 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
112 | ;; Code for testing out the grammar
113 |
114 | (comment
115 |
116 | (let [txt " - This caused an ambiguous match."]
117 | (-> (doc/document markdown)
118 | (doc/insert 0 txt)
119 | lang/parse-tree
120 | clojure.pprint/pprint))
121 |
122 | )
123 |
124 |
125 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/markdown/preview.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.markdown.preview
2 | (:require [lab.core [plugin :refer [defplugin]]
3 | [keymap :as km]
4 | [main :as main]]
5 | [lab.util :refer [timeout-channel]]
6 | [lab.model.protocols :as model]
7 | [lab.ui [core :as ui]
8 | [templates :as tmplts]]
9 | [markdown.core :as md]))
10 |
11 | (defn- view
12 | []
13 | (-> (tmplts/tab "html-preview")
14 | (ui/update-attr :header ui/update :label ui/attr :text "Html Preview")
15 | (ui/add [:scroll [:text-editor {:content-type "text/html"
16 | :line-highlight-color [0 0 0 0]
17 | :read-only true}]])))
18 |
19 | (defn- update-html-from-doc
20 | "Updates the HTML preview control with the contents
21 | of the provided doc after it is parsed as markdown."
22 | [ui doc]
23 | (let [txt (if doc (model/text @doc) "")
24 | html (md/md-to-html-string txt)]
25 | (ui/action
26 | (ui/update! ui [:#html-preview :text-editor]
27 | #(-> %
28 | (ui/attr :text html)
29 | (ui/caret-position 0))))))
30 |
31 | (defn- update-html!
32 | [{:keys [app source] :as e}]
33 | (let [ui (:ui @app)
34 | html (md/md-to-html-string (model/text source))
35 | pos (ui/caret-position source)]
36 | (ui/action
37 | (ui/update! ui [:#html-preview :text-editor]
38 | #(-> %
39 | (ui/attr :text html)
40 | (ui/caret-position (min pos
41 | (model/length %))))))))
42 |
43 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
44 | ;; hooks
45 |
46 | (defn- switch-document-hook
47 | "Hook for #'lab.core/switch-document.
48 | Updates the preview of the markup document."
49 | [f app doc]
50 | (let [app (f app doc)]
51 | (future (update-html-from-doc (:ui app) doc))
52 | app))
53 |
54 | (def ^:private hooks
55 | {#'lab.core/switch-document #'switch-document-hook})
56 |
57 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
58 | ;; keymaps commands
59 |
60 | (defn- show-preview
61 | [{:keys [app source] :as e}]
62 | (let [ui (:ui @app)
63 | id (ui/attr source :id)
64 | html (md/md-to-html-string (model/text source))
65 | tab (-> (view)
66 | ui/init
67 | (ui/update :text-editor ui/attr :text html))]
68 | (when-not (ui/find @ui :#html-preview)
69 | (ui/action
70 | (ui/update! ui :#center-right
71 | (fn [x]
72 | (-> x
73 | (ui/update-attr :divider-location (constantly 0.5))
74 | (ui/update :#right ui/add tab))))))))
75 |
76 | (def ^:private keymaps
77 | [(km/keymap "Markdown"
78 | :local
79 | {:keystroke "ctrl p" :fn ::show-preview :name "Html Preview"})])
80 |
81 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
82 | ;; init!
83 |
84 | (defn- text-editor-init [editor]
85 | (let [hl-ch (timeout-channel 250 #'update-html!)]
86 | (-> editor
87 | (ui/update-attr :stuff assoc ::listener hl-ch)
88 | (ui/listen :insert hl-ch)
89 | (ui/listen :delete hl-ch))))
90 |
91 | (defn- init! [app]
92 | (let [ui (:ui @app)
93 | editor (main/current-text-editor @ui)
94 | id (ui/attr editor :id)]
95 | (when editor
96 | (ui/update! ui (ui/id= id) text-editor-init))))
97 |
98 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
99 | ;; unload!
100 |
101 | (defn- text-editor-unload [editor]
102 | (let [hl-ch (::listener (ui/stuff editor))]
103 | (-> editor
104 | (ui/update-attr :stuff dissoc ::listener)
105 | (ui/ignore :insert hl-ch)
106 | (ui/ignore :delete hl-ch))))
107 |
108 | (defn- unload! [app]
109 | (let [ui (:ui @app)
110 | editor (main/current-text-editor @ui)
111 | id (ui/attr editor :id)]
112 | (when editor
113 | (ui/update! ui (ui/id= id) text-editor-unload))))
114 |
115 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
116 | ;; plugin definition
117 |
118 | (defplugin "Markdown HTML Preview"
119 | :type :local
120 | :init! #'init!
121 | :unload! #'unload!
122 | :hooks hooks
123 | :keymaps keymaps)
124 |
--------------------------------------------------------------------------------
/src/clj/lab/plugin/notifier.clj:
--------------------------------------------------------------------------------
1 | (ns lab.plugin.notifier
2 | (:require [lab.core.plugin :as plugin]
3 | [lab.ui.core :as ui]
4 | [lab.util :as util]
5 | [lab.ui.templates :as tplts]
6 | [clojure.repl :as repl]))
7 |
8 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9 | ;;; UI Error Handler
10 |
11 | ;; TODO: add link to files when displaying the stack trace.
12 |
13 | (defn truncate [n ^String s]
14 | (if (< n (.length s))
15 | (str (.substring s 0 n) "...")
16 | s))
17 |
18 | (defn- show-error-info
19 | [app ^Exception ex]
20 | (let [ui (@app :ui)
21 | title (->> (or (.getMessage ex) ex)
22 | str
23 | (truncate 50)
24 | (str "Error - "))
25 | tab (-> (tplts/tab "notifier")
26 | (ui/update-attr :header ui/update :label ui/attr :text title)
27 | (ui/add [:scroll {:border :none}
28 | (-> [:text-area {:text (util/stacktrace->str ex) :read-only true}]
29 | ui/init
30 | (ui/caret-position 0))]))]
31 | (ui/update! ui :#top-bottom ui/attr :divider-location-right 200)
32 | (ui/update! ui :#bottom ui/add tab)))
33 |
34 | (defn- default-error-handler
35 | [app]
36 | (let [handler (proxy [Thread$UncaughtExceptionHandler] []
37 | (uncaughtException [thread ex]
38 | (try (#'show-error-info app ex)
39 | (catch Exception new-ex
40 | (println "Exception handler threw an Exception :S " new-ex)
41 | (repl/pst ex))))
42 | (handle [ex]
43 | (#'show-error-info app ex)))
44 | class-name (-> handler class .getName)]
45 | ;(System/setProperty "sun.awt.exception.handler" class-name)
46 | (Thread/setDefaultUncaughtExceptionHandler handler)))
47 |
48 | (defn- init! [app]
49 | (default-error-handler app))
50 |
51 | (plugin/defplugin lab.plugin.notifier
52 | :type :global
53 | :init! #'init!)
54 |
--------------------------------------------------------------------------------
/src/clj/lab/test.clj:
--------------------------------------------------------------------------------
1 | (ns lab.test
2 | (:use [clojure.test :only [is]]))
3 | ;---------------------------
4 | (defmacro ->is
5 | "Rearranges its arguments in order to be
6 | able to use it in a ->test threading macro."
7 | [x binop v & f]
8 | `(clojure.test/is (~binop ~v (-> ~x ~(or f `identity)))))
9 | ;---------------------------
10 | (defmacro ->test
11 | "Threading test macro that allows to use is assert expressions
12 | in a threading style using the ->is macro."
13 | [& body]
14 | (let [->is? (fn [x]
15 | (and (seq? x) (= '->is (first x))))
16 | ops (take-while (complement ->is?) body)
17 | [[_ & args] & more]
18 | (drop-while (complement ->is?) body)]
19 | (if args
20 | `(let [x# (-> ~@ops)]
21 | (->is x# ~@args)
22 | (->test x# ~@(when (seq more) more)))
23 | `(-> ~@body))))
24 | ;---------------------------
25 | (defn ->println [x & [f & args]]
26 | (if f
27 | (println (apply f x args))
28 | (println x))
29 | x)
--------------------------------------------------------------------------------
/src/clj/lab/ui/hierarchy.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.hierarchy
2 | "Declares and builds the UI component hierarchy
3 | which can be modified using alter-var-root! for
4 | the hierarchy var.")
5 |
6 | (defn- process-hierarchy-entry
7 | "Takes a map entry from the hierarchy description
8 | and declares the parent/child relationship in the
9 | hierarchy being built."
10 | [h [parent children]]
11 | (reduce #(derive %1 %2 parent) h children))
12 |
13 | (defn- build-hierarchy
14 | "Takes a map of parent/children specifications and
15 | builds the hierachy defined in it."
16 | [h]
17 | (reduce process-hierarchy-entry (make-hierarchy) h))
18 |
19 | (def ^:private hierarchy-description
20 | "Default hierarchy description for the different types
21 | of UI components. Must be built and rebound to the result
22 | of calling [build-hierarchy]."
23 | {:component [; containers
24 | :window :panel :split :scroll
25 | :toolbar
26 | ; menu
27 | :menu-bar :menu :menu-item :menu-separator
28 | :pop-up-menu
29 | ; text
30 | :text-field
31 | :line-number
32 | ; tabs
33 | :tabs :tab
34 | ; tree
35 | :tree :tree-node
36 | ; misc
37 | :button :label :checkbox
38 | ; combobox
39 | :combobox :cb-item]
40 | :window [:dialog]
41 | :dialog [:file-dialog :option-dialog]
42 | :text-field [:text-area]
43 | :text-area [:text-editor]
44 | :text-editor [:console]})
45 |
46 | (def hierarchy (build-hierarchy hierarchy-description))
47 |
--------------------------------------------------------------------------------
/src/clj/lab/ui/menu.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.menu
2 | (:require [lab.util :as util]
3 | [lab.ui [core :as ui]
4 | [select :as ui.sel]]))
5 |
6 | (defn- menu-path
7 | "Deconstructs a menu path from a string with a '->' separator."
8 | [^String s]
9 | (when s
10 | (->> (.split s ">") seq (map clojure.string/trim))))
11 |
12 | (defn- create-menu-path
13 | "Searches the menu-bar children using the selector. If the
14 | menu defined is not found it is created, otherwise the menu-bar
15 | is returned unchanged."
16 | [menu-bar selector]
17 | (if (ui/find menu-bar selector)
18 | menu-bar
19 | (let [text (-> selector last meta :value) ; The meta from the last selector's predicate has the name of the menu.
20 | menu [:menu {:text text}]
21 | selector (or (butlast selector) [])]
22 | (ui/update menu-bar selector ui/add menu))))
23 |
24 | (defn add-option
25 | "Takes a menu option and add it to the ui menu bar.
26 | The menu option map must have the following keys:
27 | :category path in the menu.
28 | :name name of the option.
29 | :fn var to a function with args [ui evt & args].
30 | :separator true if the option should be followed by a separator."
31 | [ui {:keys [category name fn separator keystroke] :as option}]
32 | (let [menu-bar (ui/attr ui :menu)
33 | ;; Explode the menu path and build a selector.
34 | selector (map (partial ui.sel/attr= :text) (menu-path category))
35 | ;; Build selectors for each of the menu path levels.
36 | selectors (map #(->> selector (take %1) vec) (range 1 (-> selector count inc)))
37 | item (if separator
38 | [:menu-separator]
39 | [:menu-item {:text name
40 | :listen [:click fn]
41 | :keystroke (or keystroke "")}])
42 | menu-bar (reduce create-menu-path menu-bar selectors)
43 | menu-bar (ui/update menu-bar selector ui/add item)]
44 | (ui/attr ui :menu menu-bar)))
45 |
--------------------------------------------------------------------------------
/src/clj/lab/ui/protocols.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.protocols
2 | (:refer-clojure :exclude [remove])
3 | (:require [lab.ui.hierarchy :as h]))
4 |
5 | (defprotocol Component
6 | (children [this] "Gets all the children for the component.")
7 | (add [this child] "Add a child to a component. Must return the parent with the child added.")
8 | (remove [this child] "Removes child from the children collection.")
9 | (focus [this] "Gives focus to this component."))
10 |
11 | (defprotocol Abstract
12 | (impl [this] [this implementation] "Gets or sets the implementation for component."))
13 |
14 | (defprotocol Implementation
15 | (abstract [this] [this the-abstract] "Gets or sets the asbtract component for the implementation."))
16 |
17 | (defprotocol Selection
18 | (selection [this] [this selection]
19 | "Gets or sets the selection of an abstract component."))
20 |
21 | (defprotocol Event
22 | (to-map [this] "Serializes the event into a map.")
23 | (consume [this] "Consumes this event, preventing it from bubbling up.")
24 | (consumed? [this] "Returns true if the event has been consumed, false otherwise."))
25 |
26 | (defprotocol StyledTextEditor
27 | (apply-style [this tokens styles] [this start len style]
28 | "Applies a formatting style to the region defined by start and length."))
29 |
30 | (defprotocol TextEditor
31 | (add-highlight [this start end color] "Adds a highlight of the specified color from start to end and returns an identifier of the highlight.")
32 | (remove-highlight [this id] "Removed the highlight of the given id.")
33 | (caret-position [this] [this position] "Gets and sets the caret position for this text component.")
34 | (caret-location [this] "Returns the caret's location coordinates.")
35 | (goto-line [this n] "Positions the caret at the beggining of line n."))
36 |
37 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
38 | ;;; Records
39 |
40 | (defrecord UIComponent [tag attrs content])
41 |
42 | (defrecord UIEvent [source event])
43 |
44 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
45 | ;;; Multi methods
46 |
47 | (defn tag-key-dispatch [{:keys [tag]} k & _]
48 | [tag k])
49 |
50 | (defmulti initialize
51 | "Creates a component instance based on its :tag."
52 | :tag
53 | :hierarchy #'h/hierarchy)
54 |
55 | (defmulti set-attr
56 | "Sets the attribute value for this component and returns the
57 | modified component."
58 | tag-key-dispatch
59 | :hierarchy #'h/hierarchy)
60 |
61 | (defmulti listen
62 | "Add an event handler for the event specified."
63 | tag-key-dispatch
64 | :hierarchy #'h/hierarchy)
65 |
66 | (defmulti ignore
67 | "Remove an event handler for the event specified."
68 | tag-key-dispatch
69 | :hierarchy #'h/hierarchy)
70 |
--------------------------------------------------------------------------------
/src/clj/lab/ui/swing/console.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.swing.console
2 | (:require [lab.ui.core :as ui]
3 | [lab.ui.util :refer [definitializations defattributes]])
4 | (:import lab.ui.swing.JConsole))
5 |
6 | (defn console-init [c]
7 | (let [{:keys [cin cout]} (ui/attr c :conn)]
8 | (JConsole. cout cin)))
9 |
10 | (definitializations
11 | :console console-init)
12 |
13 | (defattributes
14 | :console
15 | (:conn [c _ _]))
--------------------------------------------------------------------------------
/src/clj/lab/ui/swing/dialog.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.swing.dialog
2 | (:require [lab.ui.core :as ui]
3 | [lab.ui.util :refer [defattributes definitializations]]
4 | [lab.ui.protocols :refer [abstract impl]]
5 | [lab.ui.swing.util :as util])
6 | (:import [javax.swing JDialog JFileChooser JOptionPane JFrame]))
7 |
8 | (defn- dialog-init [c]
9 | (let [abs (atom nil)
10 | owner (as-> (ui/attr c :owner) x (when x ^JFrame (impl x)))
11 | undecorated (ui/attr c :undecorated)
12 | dialog (proxy [JDialog lab.ui.protocols.Implementation] [owner]
13 | (abstract ([] @abs)
14 | ([x] (reset! abs x) this)))]
15 | (util/register-key-binding (.getRootPane dialog) "escape"
16 | (fn [e] (.setVisible dialog false) (.dispose dialog))
17 | :focused-window)
18 | (doto dialog
19 | (.setUndecorated (boolean undecorated)))))
20 |
21 | (definitializations
22 | :file-dialog JFileChooser
23 | :option-dialog JOptionPane
24 | :dialog dialog-init)
25 |
26 | (def ^:private options-result
27 | {JOptionPane/OK_OPTION :ok
28 | JOptionPane/NO_OPTION :no
29 | JOptionPane/CANCEL_OPTION :cancel
30 | JOptionPane/CLOSED_OPTION :closed})
31 |
32 | (def ^:private options-type
33 | {:default JOptionPane/DEFAULT_OPTION
34 | :yes-no JOptionPane/YES_NO_OPTION
35 | :yes-no-cancel JOptionPane/YES_NO_CANCEL_OPTION
36 | :ok-cancel JOptionPane/OK_CANCEL_OPTION})
37 |
38 | (def ^:private selection-type
39 | {:dir-only JFileChooser/DIRECTORIES_ONLY
40 | :dir-and-file JFileChooser/FILES_AND_DIRECTORIES
41 | :file-only JFileChooser/FILES_ONLY})
42 |
43 | (defn- file-dialog-open [c]
44 | (let [x ^JFileChooser (impl c)
45 | owner (as-> (ui/attr c :owner) owner (when owner (impl owner)))
46 | result (case (ui/attr c :type)
47 | :open (.showOpenDialog x owner)
48 | :save (.showSaveDialog x owner)
49 | :custom (.showDialog x owner (ui/attr c :accept-label)))]
50 | [result (.getSelectedFile x)]))
51 |
52 | (defn- file-dialog-result [result chosen]
53 | (condp = result
54 | nil [:invalid-result nil]
55 | JFileChooser/CANCEL_OPTION [:cancel chosen]
56 | JFileChooser/APPROVE_OPTION [:accept chosen]
57 | JFileChooser/ERROR_OPTION [:error chosen]))
58 |
59 | (defn- option-dialog-open [c]
60 | (let [owner (ui/attr c :owner)
61 | title (ui/attr c :title)
62 | msg (ui/attr c :message)
63 | options (ui/attr c :options)]
64 | (JOptionPane/showConfirmDialog
65 | (when owner (impl owner))
66 | ^Object (ui/attr c :message)
67 | ^String (ui/attr c :title)
68 | ^int (options-type options))))
69 |
70 | (defn- apply-attr
71 | "Used to ensure that the value of the attribute
72 | is set before processing other attribute's code."
73 | [c k]
74 | (ui/attr c k (ui/attr c k)))
75 |
76 | (defattributes
77 | :dialog
78 | (:owner [c _ _])
79 | (:result [c _ _])
80 | (:modal [c _ v]
81 | (.setModal ^JDialog (impl c) v))
82 | (:size [c _ [w h]]
83 | (.setSize ^JDialog (impl c) (util/dimension w h)))
84 | (:title [c _ v]
85 | (.setTitle ^JDialog (impl c) v))
86 | (:visible [c _ v]
87 | (when (ui/attr c :owner)
88 | (.setLocationRelativeTo ^JDialog (impl c) (impl (ui/attr c :owner))))
89 | (.setVisible ^JDialog (impl c) v))
90 | (:default-button [c _ v]
91 | (.. ^JDialog (impl c) getRootPane (setDefaultButton (impl v))))
92 | (:resizable [c _ v]
93 | (.setResizable ^JDialog (impl c) v))
94 | (:undecorated [c _ v])
95 |
96 | :file-dialog
97 | (:title [c _ v]
98 | (.setDialogTitle ^JFileChooser (impl c) v))
99 | (:type [c _ v])
100 | (:current-dir [c _ ^String v]
101 | (when v
102 | (.setCurrentDirectory ^JFileChooser (impl c) (java.io.File. v))))
103 | (:selection-type [c _ v]
104 | (when (selection-type v)
105 | (.setFileSelectionMode ^JFileChooser (impl c) (selection-type v))))
106 | (:visible ^:modify [c _ v]
107 | (when v
108 | (->> (reduce apply-attr c [:selection-type :title :current-dir])
109 | file-dialog-open
110 | (apply file-dialog-result)
111 | (ui/attr c :result))))
112 |
113 | :option-dialog
114 | (:title [c _ _])
115 | (:visible ^:modify [c _ v]
116 | (apply-attr c :title)
117 | (apply-attr c :message)
118 | (apply-attr c :options)
119 | (when v
120 | (->> c
121 | option-dialog-open
122 | options-result
123 | (ui/attr c :result))))
124 | (:icon [c _ v]
125 | (.setIcon ^JOptionPane (impl c) (util/icon v)))
126 | (:message [c _ v]
127 | (.setMessage ^JOptionPane (impl c) v))
128 | (:options [c _ v]
129 | (when-let [t (options-type v)]
130 | (.setOptionType ^JOptionPane (impl c) t))))
131 |
--------------------------------------------------------------------------------
/src/clj/lab/ui/swing/keys.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.swing.keys
2 | (:import java.awt.event.KeyEvent))
3 |
4 | (def swing-keys
5 | {KeyEvent/VK_0 :0,
6 | KeyEvent/VK_1 :1,
7 | KeyEvent/VK_2 :2,
8 | KeyEvent/VK_3 :3,
9 | KeyEvent/VK_4 :4,
10 | KeyEvent/VK_5 :5,
11 | KeyEvent/VK_6 :6,
12 | KeyEvent/VK_7 :7,
13 | KeyEvent/VK_8 :8,
14 | KeyEvent/VK_9 :9,
15 | KeyEvent/VK_A :a,
16 | KeyEvent/VK_ACCEPT :accept,
17 | KeyEvent/VK_ADD :add,
18 | KeyEvent/VK_AGAIN :again,
19 | KeyEvent/VK_ALL_CANDIDATES :all_candidates,
20 | KeyEvent/VK_ALPHANUMERIC :alphanumeric,
21 | KeyEvent/VK_ALT :alt,
22 | KeyEvent/VK_ALT_GRAPH :alt_graph,
23 | KeyEvent/VK_AMPERSAND :ampersand,
24 | KeyEvent/VK_ASTERISK :asterisk,
25 | KeyEvent/VK_AT :at,
26 | KeyEvent/VK_B :b,
27 | KeyEvent/VK_BACK_QUOTE :back_quote,
28 | KeyEvent/VK_BACK_SLASH :back_slash,
29 | KeyEvent/VK_BACK_SPACE :back_space,
30 | KeyEvent/VK_BEGIN :begin,
31 | KeyEvent/VK_BRACELEFT :braceleft,
32 | KeyEvent/VK_BRACERIGHT :braceright,
33 | KeyEvent/VK_C :c,
34 | KeyEvent/VK_CANCEL :cancel,
35 | KeyEvent/VK_CAPS_LOCK :caps_lock,
36 | KeyEvent/VK_CIRCUMFLEX :circumflex,
37 | KeyEvent/VK_CLEAR :clear,
38 | KeyEvent/VK_CLOSE_BRACKET :close_bracket,
39 | KeyEvent/VK_CODE_INPUT :code_input,
40 | KeyEvent/VK_COLON :colon,
41 | KeyEvent/VK_COMMA :comma,
42 | KeyEvent/VK_COMPOSE :compose,
43 | KeyEvent/VK_CONTEXT_MENU :context_menu,
44 | KeyEvent/VK_CONTROL :control,
45 | KeyEvent/VK_CONVERT :convert,
46 | KeyEvent/VK_COPY :copy,
47 | KeyEvent/VK_CUT :cut,
48 | KeyEvent/VK_D :d,
49 | KeyEvent/VK_DEAD_ABOVEDOT :dead_abovedot,
50 | KeyEvent/VK_DEAD_ABOVERING :dead_abovering,
51 | KeyEvent/VK_DEAD_ACUTE :dead_acute,
52 | KeyEvent/VK_DEAD_BREVE :dead_breve,
53 | KeyEvent/VK_DEAD_CARON :dead_caron,
54 | KeyEvent/VK_DEAD_CEDILLA :dead_cedilla,
55 | KeyEvent/VK_DEAD_CIRCUMFLEX :dead_circumflex,
56 | KeyEvent/VK_DEAD_DIAERESIS :dead_diaeresis,
57 | KeyEvent/VK_DEAD_DOUBLEACUTE :dead_doubleacute,
58 | KeyEvent/VK_DEAD_GRAVE :dead_grave,
59 | KeyEvent/VK_DEAD_IOTA :dead_iota,
60 | KeyEvent/VK_DEAD_MACRON :dead_macron,
61 | KeyEvent/VK_DEAD_OGONEK :dead_ogonek,
62 | KeyEvent/VK_DEAD_SEMIVOICED_SOUND :dead_semivoiced_sound,
63 | KeyEvent/VK_DEAD_TILDE :dead_tilde,
64 | KeyEvent/VK_DEAD_VOICED_SOUND :dead_voiced_sound,
65 | KeyEvent/VK_DECIMAL :decimal,
66 | KeyEvent/VK_DELETE :delete,
67 | KeyEvent/VK_DIVIDE :divide,
68 | KeyEvent/VK_DOLLAR :dollar,
69 | KeyEvent/VK_DOWN :down,
70 | KeyEvent/VK_E :e,
71 | KeyEvent/VK_END :end,
72 | KeyEvent/VK_ENTER :enter,
73 | KeyEvent/VK_EQUALS :equals,
74 | KeyEvent/VK_ESCAPE :escape,
75 | KeyEvent/VK_EURO_SIGN :euro_sign,
76 | KeyEvent/VK_EXCLAMATION_MARK :exclamation_mark,
77 | KeyEvent/VK_F :f,
78 | KeyEvent/VK_F1 :f1,
79 | KeyEvent/VK_F10 :f10,
80 | KeyEvent/VK_F11 :f11,
81 | KeyEvent/VK_F12 :f12,
82 | KeyEvent/VK_F13 :f13,
83 | KeyEvent/VK_F14 :f14,
84 | KeyEvent/VK_F15 :f15,
85 | KeyEvent/VK_F16 :f16,
86 | KeyEvent/VK_F17 :f17,
87 | KeyEvent/VK_F18 :f18,
88 | KeyEvent/VK_F19 :f19,
89 | KeyEvent/VK_F2 :f2,
90 | KeyEvent/VK_F20 :f20,
91 | KeyEvent/VK_F21 :f21,
92 | KeyEvent/VK_F22 :f22,
93 | KeyEvent/VK_F23 :f23,
94 | KeyEvent/VK_F24 :f24,
95 | KeyEvent/VK_F3 :f3,
96 | KeyEvent/VK_F4 :f4,
97 | KeyEvent/VK_F5 :f5,
98 | KeyEvent/VK_F6 :f6,
99 | KeyEvent/VK_F7 :f7,
100 | KeyEvent/VK_F8 :f8,
101 | KeyEvent/VK_F9 :f9,
102 | KeyEvent/VK_FINAL :final,
103 | KeyEvent/VK_FIND :find,
104 | KeyEvent/VK_FULL_WIDTH :full_width,
105 | KeyEvent/VK_G :g,
106 | KeyEvent/VK_GREATER :greater,
107 | KeyEvent/VK_H :h,
108 | KeyEvent/VK_HALF_WIDTH :half_width,
109 | KeyEvent/VK_HELP :help,
110 | KeyEvent/VK_HIRAGANA :hiragana,
111 | KeyEvent/VK_HOME :home,
112 | KeyEvent/VK_I :i,
113 | KeyEvent/VK_INPUT_METHOD_ON_OFF :input_method_on_off,
114 | KeyEvent/VK_INSERT :insert,
115 | KeyEvent/VK_INVERTED_EXCLAMATION_MARK :inverted_exclamation_mark,
116 | KeyEvent/VK_J :j,
117 | KeyEvent/VK_JAPANESE_HIRAGANA :japanese_hiragana,
118 | KeyEvent/VK_JAPANESE_KATAKANA :japanese_katakana,
119 | KeyEvent/VK_JAPANESE_ROMAN :japanese_roman,
120 | KeyEvent/VK_K :k,
121 | KeyEvent/VK_KANA :kana,
122 | KeyEvent/VK_KANA_LOCK :kana_lock,
123 | KeyEvent/VK_KANJI :kanji,
124 | KeyEvent/VK_KATAKANA :katakana,
125 | KeyEvent/VK_KP_DOWN :kp_down,
126 | KeyEvent/VK_KP_LEFT :kp_left,
127 | KeyEvent/VK_KP_RIGHT :kp_right,
128 | KeyEvent/VK_KP_UP :kp_up,
129 | KeyEvent/VK_L :l,
130 | KeyEvent/VK_LEFT :left,
131 | KeyEvent/VK_LEFT_PARENTHESIS :left_parenthesis,
132 | KeyEvent/VK_LESS :less,
133 | KeyEvent/VK_M :m,
134 | KeyEvent/VK_META :meta,
135 | KeyEvent/VK_MINUS :minus,
136 | KeyEvent/VK_MODECHANGE :modechange,
137 | KeyEvent/VK_MULTIPLY :multiply,
138 | KeyEvent/VK_N :n,
139 | KeyEvent/VK_NONCONVERT :nonconvert,
140 | KeyEvent/VK_NUMBER_SIGN :number_sign,
141 | KeyEvent/VK_NUMPAD0 :numpad0,
142 | KeyEvent/VK_NUMPAD1 :numpad1,
143 | KeyEvent/VK_NUMPAD2 :numpad2,
144 | KeyEvent/VK_NUMPAD3 :numpad3,
145 | KeyEvent/VK_NUMPAD4 :numpad4,
146 | KeyEvent/VK_NUMPAD5 :numpad5,
147 | KeyEvent/VK_NUMPAD6 :numpad6,
148 | KeyEvent/VK_NUMPAD7 :numpad7,
149 | KeyEvent/VK_NUMPAD8 :numpad8,
150 | KeyEvent/VK_NUMPAD9 :numpad9,
151 | KeyEvent/VK_NUM_LOCK :num_lock,
152 | KeyEvent/VK_O :o,
153 | KeyEvent/VK_OPEN_BRACKET :open_bracket,
154 | KeyEvent/VK_P :p,
155 | KeyEvent/VK_PAGE_DOWN :page_down,
156 | KeyEvent/VK_PAGE_UP :page_up,
157 | KeyEvent/VK_PASTE :paste,
158 | KeyEvent/VK_PAUSE :pause,
159 | KeyEvent/VK_PERIOD :period,
160 | KeyEvent/VK_PLUS :plus,
161 | KeyEvent/VK_PREVIOUS_CANDIDATE :previous_candidate,
162 | KeyEvent/VK_PRINTSCREEN :printscreen,
163 | KeyEvent/VK_PROPS :props,
164 | KeyEvent/VK_Q :q,
165 | KeyEvent/VK_QUOTE :quote,
166 | KeyEvent/VK_QUOTEDBL :quotedbl,
167 | KeyEvent/VK_R :r,
168 | KeyEvent/VK_RIGHT :right,
169 | KeyEvent/VK_RIGHT_PARENTHESIS :right_parenthesis,
170 | KeyEvent/VK_ROMAN_CHARACTERS :roman_characters,
171 | KeyEvent/VK_S :s,
172 | KeyEvent/VK_SCROLL_LOCK :scroll_lock,
173 | KeyEvent/VK_SEMICOLON :semicolon,
174 | ;; KeyEvent/VK_SEPARATER :separater, ;; This has the same code as the above
175 | KeyEvent/VK_SEPARATOR :separator,
176 | KeyEvent/VK_SHIFT :shift,
177 | KeyEvent/VK_SLASH :slash,
178 | KeyEvent/VK_SPACE :space,
179 | KeyEvent/VK_STOP :stop,
180 | KeyEvent/VK_SUBTRACT :subtract,
181 | KeyEvent/VK_T :t,
182 | KeyEvent/VK_TAB :tab,
183 | KeyEvent/VK_U :u,
184 | KeyEvent/VK_UNDEFINED :undefined,
185 | KeyEvent/VK_UNDERSCORE :underscore,
186 | KeyEvent/VK_UNDO :undo,
187 | KeyEvent/VK_UP :up,
188 | KeyEvent/VK_V :v,
189 | KeyEvent/VK_W :w,
190 | KeyEvent/VK_WINDOWS :windows,
191 | KeyEvent/VK_X :x,
192 | KeyEvent/VK_Y :y,
193 | KeyEvent/VK_Z :z})
194 |
195 | (comment
196 | ;; Code used to generate the above map.
197 | (->> KeyEvent
198 | .getFields
199 | seq
200 | (filter #(.startsWith (.getName %) "VK_"))
201 | (map #(vector (->> (.getName %) (str "KeyEvent/") symbol)
202 | (-> % .getName (.replace "VK_" "") .toLowerCase keyword)))
203 | (sort-by first)
204 | (into (sorted-map))
205 | clojure.pprint/pprint)
206 |
207 | ;; Code used to figure out repeated key.
208 | (->> KeyEvent
209 | .getFields
210 | seq
211 | (filter #(.startsWith (.getName %) "VK_"))
212 | (map #(->> (.getName %) (str "KeyEvent/") symbol))
213 | (map eval)
214 | frequencies
215 | (filter #(-> % second (> 1)))
216 | clojure.pprint/pprint)
217 |
218 | ;; Generate the tables for documentation
219 | (->> swing-keys
220 | (map (fn [[k v]]
221 | {:desc (KeyEvent/getKeyText k)
222 | :name (str "`" (name v) "`")
223 | :char (char k)}))
224 | (sort-by :name)
225 | (clojure.pprint/print-table [:desc :name]))
226 |
227 | )
--------------------------------------------------------------------------------
/src/clj/lab/ui/swing/menu.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.swing.menu
2 | (:require [lab.ui.core :as ui]
3 | [lab.ui.protocols :refer [impl to-map listen ignore]]
4 | [lab.ui.util :refer [defattributes definitializations]]
5 | [lab.ui.swing.util :as util])
6 | (:import [javax.swing JMenuBar JMenu JMenuItem JSeparator JPopupMenu JComponent]
7 | [java.awt.event ActionListener]))
8 |
9 | (definitializations
10 | ;; Menu
11 | :menu-bar JMenuBar
12 | :menu JMenu
13 | :menu-item JMenuItem
14 | :menu-separator JSeparator
15 | :pop-up-menu JPopupMenu)
16 |
17 | (defattributes
18 | :menu
19 | (:text [c _ v]
20 | (.setText ^JMenu (impl c) v))
21 |
22 | :pop-up-menu
23 | (:visible [c _ v]
24 | (let [invoker (impl (ui/attr c :source))
25 | [x y] (ui/attr c :location)
26 | menu ^JPopupMenu (impl c)]
27 | (if v
28 | (.show menu invoker x y))
29 | (.setVisible menu v)))
30 | (:source [c _ v]
31 | (let [popup ^JPopupMenu (impl c)
32 | component ^JComponent (impl v)]
33 | (.setInvoker popup component)
34 | (.setComponentPopupMenu component popup)))
35 |
36 | :menu-item
37 | (:text [c _ v]
38 | (.setText ^JMenuItem (impl c) v))
39 | (:keystroke [c _ ks]
40 | (.setAccelerator ^JMenuItem (impl c) (util/keystroke ks))))
41 |
42 | (defmethod listen [:menu-item :click]
43 | [c evt f]
44 | (let [listener (util/create-listener c evt f)]
45 | (.addActionListener ^JMenuItem (impl c) listener)
46 | listener))
47 |
48 | (defmethod ignore [:menu-item :click]
49 | [c _ listener]
50 | (.removeActionListener ^JMenuItem (impl c) listener))
51 |
--------------------------------------------------------------------------------
/src/clj/lab/ui/swing/misc_control.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.swing.misc-control
2 | (:require [lab.ui.core :as ui]
3 | [lab.ui.util :refer [defattributes definitializations]]
4 | [lab.ui.protocols :refer [impl abstract
5 | Selection selection
6 | Component
7 | listen ignore]]
8 | [lab.ui.swing.util :as util])
9 | (:import [javax.swing JButton JLabel JCheckBox JComboBox]))
10 |
11 | (defn- combobox-item-init
12 | [c]
13 | (let [abs (atom nil)
14 | impl (proxy [Object lab.ui.protocols.Implementation] []
15 | (toString [] (ui/attr c :text))
16 | (abstract
17 | ([] @abs)
18 | ([x] (reset! abs x) this)))]
19 | impl))
20 |
21 | (definitializations
22 | :button JButton
23 | :label JLabel
24 | :checkbox JCheckBox
25 | :combobox JComboBox
26 | :cb-item combobox-item-init)
27 |
28 | (defattributes
29 | :button
30 | (:text [c _ v]
31 | (.setText ^JButton (impl c) v))
32 | (:transparent [c _ v]
33 | (.setContentAreaFilled ^JButton (impl c) (not v)))
34 | (:icon [c _ img]
35 | (.setIcon ^JButton (impl c) (util/icon img)))
36 |
37 | :label
38 | (:text [c _ v]
39 | (.setText ^JLabel (impl c) v))
40 |
41 | :checkbox
42 | (:text [c _ v]
43 | (.setText ^JCheckBox (impl c) v))
44 |
45 | :combobox
46 | (:editable [c _ v]
47 | (.setEditable ^JComboBox (impl c) v))
48 |
49 | :cb-item
50 | (:text [c _ v]))
51 |
52 | (extend-type JCheckBox
53 | Selection
54 | (selection
55 | ([this]
56 | (.isSelected this))
57 | ([this v]
58 | (.setSelected this v))))
59 |
60 | (extend-type JComboBox
61 | Component
62 | (children [this] nil)
63 | (add [this child]
64 | (.addItem this child)
65 | this)
66 | (remove [this child]
67 | (.removeItem this child))
68 | (focus [this]
69 | (.grabFocus this)))
70 |
71 | (defmethod listen [:button :click]
72 | [c evt f]
73 | (let [listener (util/create-listener c evt f)]
74 | (.addActionListener ^JButton (impl c) listener)
75 | listener))
76 |
77 | (defmethod ignore [:button :click]
78 | [c _ listener]
79 | (.removeActionListener ^JButton (impl c) listener))
80 |
--------------------------------------------------------------------------------
/src/clj/lab/ui/swing/panel.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.swing.panel
2 | (:use [lab.ui.protocols :only [Component impl]])
3 | (:require [lab.ui.core :as ui]
4 | [lab.ui.util :refer [defattributes definitializations]]
5 | [lab.ui.swing.util :as util])
6 | (:import [javax.swing JPanel JSplitPane JScrollPane JButton JComponent]
7 | [java.awt BorderLayout]
8 | [javax.swing.plaf.basic BasicSplitPaneDivider BasicSplitPaneUI]))
9 |
10 | (util/set-prop "scrollbar" (util/color 0xCC0000))
11 | (util/set-prop "ScrollBar.background" (util/color 0xCCCCCC))
12 | (util/set-prop "ScrollBar.darkShadow" (util/color 0xCCCCCC))
13 | (util/set-prop "ScrollBar.foreground" (util/color 0xCCCCCC))
14 | (util/set-prop "ScrollBar.highlight" (util/color 0xCCCCCC))
15 | (util/set-prop "ScrollBar.shadow" (util/color 0xCCCCCC))
16 |
17 | (util/set-prop "ScrollBar.track" (util/color 0xCCCCCC))
18 | (util/set-prop "ScrollBar.trackForeground" (util/color 0xCCCCCC))
19 | (util/set-prop "ScrollBar.trackHighlight" (util/color 0xCCCCCC))
20 | (util/set-prop "ScrollBar.trackHighlightForeground" (util/color 0xCCCCCC))
21 |
22 | (util/set-prop "ScrollBar.thumb" (util/color 0xCCCCCC))
23 | (util/set-prop "ScrollBar.thumbDarkShadow" (util/color 0xCCCCCC))
24 | (util/set-prop "ScrollBar.thumbHighlight" (util/color 0xCCCCCC))
25 | (util/set-prop "ScrollBar.thumbShadow" (util/color 0xCCCCCC))
26 |
27 | (util/set-prop "ScrollBar.width" (int 15))
28 | (util/set-prop "ScrollBar.height" (int 15))
29 |
30 | (extend-protocol Component
31 | JSplitPane
32 | (add [this child]
33 | ; Assume that if the top component is a button then
34 | ; it is because it was never set
35 | (if (instance? JButton (.getTopComponent this))
36 | (.setTopComponent this child)
37 | (.setBottomComponent this child))
38 | (util/remove-focus-traversal child)
39 | this)
40 |
41 | JScrollPane
42 | (add [this child]
43 | (.. this getViewport (add ^java.awt.Container child nil))
44 | (util/remove-focus-traversal child)
45 | this)
46 | (remove [this child]
47 | (.. this getViewport (remove ^java.awt.Container child))
48 | this))
49 |
50 | (defn- find-divider [^JSplitPane split]
51 | (->> split
52 | .getComponents
53 | (filter (partial instance? BasicSplitPaneDivider))
54 | first))
55 |
56 | (defn- init-split
57 | "Create the split pane and replace the UI implementation for a
58 | bare one, so that the divider and the rest of its properties can be
59 | set, regardless of the Look & Feel used."
60 | [c]
61 | (doto (JSplitPane.)
62 | (.setUI (BasicSplitPaneUI.))))
63 |
64 | (definitializations
65 | :split init-split
66 | :panel JPanel
67 | :scroll JScrollPane)
68 |
69 | (defattributes
70 | :split
71 | (:divider-background [c _ v]
72 | (.setBackground ^BasicSplitPaneDivider (find-divider (impl c)) (util/color v)))
73 | (:border [c _ v]
74 | (let [v (if (sequential? v) v [v])
75 | border (apply util/border v)
76 | split ^JSplitPane (impl c)
77 | divider ^BasicSplitPaneDivider (find-divider split)]
78 | (.setBorder split border)
79 | (.setBorder divider border)))
80 | (:resize-weight [c _ v]
81 | (.setResizeWeight ^JSplitPane (impl c) v))
82 | (:divider-location [c _ v]
83 | (if (integer? v)
84 | (.setDividerLocation ^JSplitPane (impl c) ^int v)
85 | (.setDividerLocation ^JSplitPane (impl c) ^float v)))
86 | (:divider-location-right [c _ v]
87 | (let [split ^JSplitPane (impl c)
88 | orientation (.getOrientation split)
89 | size (if (= orientation (util/split-orientations :horizontal))
90 | (.getWidth split)
91 | (.getHeight split))]
92 | (if (float? v)
93 | (.setDividerLocation split (float (- 1 (/ v size))))
94 | (ui/attr c :divider-location (- size v)))))
95 | (:divider-size [c _ v]
96 | (.setDividerSize ^JSplitPane (impl c) v))
97 | (:orientation [c _ v]
98 | (.setOrientation ^JSplitPane (impl c) (util/split-orientations v)))
99 | :scroll
100 | (:layout [c _ v]
101 | (throw (ex-info "Can't change the layout of a :scroll component:" {:layout v})))
102 | (:vertical-increment [c _ v]
103 | (.. ^JScrollPane (impl c) getVerticalScrollBar (setUnitIncrement 16)))
104 | (:margin-control [c _ v]
105 | (.setRowHeaderView ^JScrollPane (impl c) (impl v))))
106 |
--------------------------------------------------------------------------------
/src/clj/lab/ui/swing/tab.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.swing.tab
2 | (:use [lab.ui.protocols :only [Component abstract impl Selection selection to-map listen ignore]])
3 | (:require [lab.ui.core :as ui]
4 | [lab.ui.util :refer [defattributes definitializations]]
5 | [lab.ui.swing.util :as util :refer [set-prop]])
6 | (:import [javax.swing JTabbedPane JPanel JComponent]))
7 |
8 | (def transparent (util/color [0 0 0 0]))
9 | (def no-insets (util/insets [0 0 0 0]))
10 |
11 | (set-prop "TabbedPane.tabAreaInsets" no-insets)
12 | (set-prop "TabbedPane.tabInsets" no-insets)
13 | (set-prop "TabbedPane.selectedTabPadInsets" no-insets)
14 | (set-prop "TabbedPane.contentBorderInsets" no-insets)
15 |
16 | (set-prop "TabbedPane.tabsOverlapBorder" true)
17 | (set-prop "TabbedPane.selectionFollowsFocus" true)
18 | (set-prop "TabbedPane.opaque" false)
19 | (set-prop "TabbedPane.tabsOpaque" false)
20 |
21 | (set-prop "TabbedPane.labelShift" 0)
22 | (set-prop "TabbedPane.textIconGap" 0)
23 | (set-prop "TabbedPane.tabRunOverlay" 0)
24 | (set-prop "TabbedPane.selectedLabelShift" 0)
25 |
26 | (set-prop "TabbedPane.darkShadow" transparent)
27 | (set-prop "TabbedPane.highlight" transparent)
28 | (set-prop "TabbedPane.light" transparent)
29 | (set-prop "TabbedPane.shadow" transparent)
30 |
31 | (set-prop "TabbedPane.borderHightlightColor" transparent)
32 | (set-prop "TabbedPane.selectHighlight" transparent)
33 | (set-prop "TabbedPane.background" transparent)
34 | (set-prop "TabbedPane.foreground" transparent)
35 |
36 | (set-prop "TabbedPane.unselectedBackground" transparent)
37 | (set-prop "TabbedPane.selected" transparent)
38 | (set-prop "TabbedPane.tabAreaBackground" transparent)
39 | (set-prop "TabbedPane.focus" transparent)
40 | (set-prop "TabbedPane.contentAreaColor" transparent)
41 |
42 | (defn- style-tab-header [tab style]
43 | (reduce-kv ui/attr (ui/attr tab :header) style))
44 |
45 | (defn- highlight-current-tab [e]
46 | (let [{:keys [source]} (to-map e)
47 | sel-style (ui/attr source :selected-tab-style)
48 | unsel-style (ui/attr source :unselected-tab-style)
49 | sel-id (selection source)]
50 | (doseq [tab (ui/children source)]
51 | (style-tab-header tab unsel-style))
52 | (ui/update source (ui/id= sel-id) style-tab-header sel-style)))
53 |
54 | (defn- tab-init [c]
55 | (doto (JPanel.)
56 | (.setLayout (java.awt.BorderLayout.))))
57 |
58 | (defn- tabs-init [c]
59 | (doto (JTabbedPane.)
60 | (.setTabLayoutPolicy JTabbedPane/WRAP_TAB_LAYOUT)
61 | (.addChangeListener (util/create-listener c :change #'highlight-current-tab))))
62 |
63 | (definitializations
64 | :tabs tabs-init
65 | :tab tab-init)
66 |
67 | (extend-protocol Component
68 | JTabbedPane
69 | (children [this child]
70 | (.getComponents this))
71 | (add [this child]
72 | (let [i (.getTabCount this)
73 | child-abs (abstract child)
74 | header (when-let [h (ui/attr child-abs :header)] (impl h))
75 | tool-tip (ui/attr child-abs :tool-tip)
76 | title (ui/attr child-abs :title)]
77 | (.addTab this title child)
78 | (util/remove-focus-traversal child)
79 | (when header (.setTabComponentAt this i header))
80 | (when tool-tip (.setToolTipTextAt this i tool-tip))
81 | (selection this i))
82 | this)
83 | (remove [this child]
84 | (.remove this ^JComponent child)
85 | this))
86 |
87 | (extend-protocol Selection
88 | JTabbedPane
89 | (selection
90 | ([this]
91 | (let [index (.getSelectedIndex this)]
92 | (when (<= 0 index)
93 | (-> this
94 | (.getComponentAt index)
95 | abstract
96 | (ui/attr :id)))))
97 | ([this index]
98 | (.setSelectedIndex this index))))
99 |
100 | (defattributes
101 | :tabs
102 | (:selected-tab-style [c _ _])
103 | (:unselected-tab-style [c _ _])
104 |
105 | :tab
106 | (:title [c _ _])
107 | (:tool-tip [c _ _])
108 | (:header [c _ _]))
109 |
110 | (defmethod listen [:tabs :change]
111 | [c evt f]
112 | (let [listener (util/create-listener c evt f)]
113 | (.addChangeListener ^JTabbedPane (impl c) listener)))
114 |
115 | (defmethod ignore [:tabs :change]
116 | [c _ listener]
117 | (.removeChangeListener ^JTabbedPane (impl c) listener))
118 |
--------------------------------------------------------------------------------
/src/clj/lab/ui/swing/toolbar.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.swing.toolbar
2 | (:require [lab.ui.core :as ui]
3 | [lab.ui.protocols :refer [impl to-map listen ignore]]
4 | [lab.ui.util :refer [defattributes definitializations]]
5 | [lab.ui.swing.util :as util])
6 | (:import [javax.swing JToolBar]))
7 |
8 | (definitializations
9 | :toolbar JToolBar)
10 |
11 | (defattributes
12 | :toolbar
13 | (:floatable [c _ v]
14 | (.setFloatable ^JToolBar (impl c) v)))
15 |
--------------------------------------------------------------------------------
/src/clj/lab/ui/swing/window.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.swing.window
2 | (:require [lab.ui.core :as ui]
3 | [lab.ui.util :refer [defattributes definitializations]]
4 | [lab.ui.swing.util :as util]
5 | [lab.ui.protocols :refer [impl Implementation listen ignore abstract]])
6 | (:import [javax.swing JFrame WindowConstants]
7 | [java.awt Window]
8 | [java.awt.event WindowAdapter]))
9 |
10 | (defn- window-init [c]
11 | (let [ab (atom nil)
12 | window (proxy [JFrame lab.ui.protocols.Implementation] []
13 | (abstract
14 | ([] @ab)
15 | ([x] (reset! ab x) this)))]
16 | (doto window
17 | (.setDefaultCloseOperation WindowConstants/DO_NOTHING_ON_CLOSE))))
18 |
19 | (definitializations :window window-init)
20 |
21 | (defattributes
22 | :window
23 | (:background [c _ v]
24 | (.. ^Window (impl c) (setBackground (util/color v))))
25 | (:opacity [c _ v]
26 | (.setOpacity ^Window (impl c) ^float v))
27 | (:fullscreen [c _ v]
28 | (util/fullscreen (when v (impl c))))
29 | (:title [c _ v]
30 | (.setTitle ^JFrame (impl c) v))
31 | (:maximized [c _ v]
32 | (when v
33 | (.setExtendedState ^JFrame (impl c)
34 | (bit-or (.getExtendedState ^JFrame (impl c))
35 | JFrame/MAXIMIZED_BOTH))))
36 | (:size [c _ [w h]]
37 | (.setSize ^JFrame (impl c) w h))
38 | (:menu [c _ v]
39 | (.setJMenuBar ^JFrame (impl c) (impl v))
40 | (.revalidate ^JFrame (impl c)))
41 | (:icons [c _ v]
42 | (let [icons (map util/image v)]
43 | (.setIconImages ^JFrame (impl c) icons)))
44 | (:default-button [c _ v]
45 | (.. ^JFrame (impl c) getRootPane (setDefaultButton (impl v)))))
46 |
47 | (defn- event-listener-helper [c evt f]
48 | (let [listener (util/create-listener c evt f)]
49 | (.addWindowListener ^JFrame (impl c) listener)
50 | listener))
51 |
52 | (defn- event-ignore-helper [c evt listener]
53 | (.removeWindowListener ^JFrame (impl c) listener))
54 |
55 | (defmethod listen [:window :closed]
56 | [c evt f]
57 | (event-listener-helper c evt f))
58 |
59 | (defmethod ignore [:window :closed]
60 | [c evt listener]
61 | (event-ignore-helper c evt listener))
62 |
63 | (defmethod listen [:window :closing]
64 | [c evt f]
65 | (event-listener-helper c evt f))
66 |
67 | (defmethod ignore [:window :closing]
68 | [c evt listener]
69 | (event-ignore-helper c evt listener))
70 |
71 | (defmethod listen [:window :opened]
72 | [c evt f]
73 | (event-listener-helper c evt f))
74 |
75 | (defmethod ignore [:window :opened]
76 | [c evt listener]
77 | (event-ignore-helper c evt listener))
78 |
79 | (defmethod listen [:window :minimized]
80 | [c evt f]
81 | (event-listener-helper c evt f))
82 |
83 | (defmethod ignore [:window :minimized]
84 | [c evt listener]
85 | (event-ignore-helper c evt listener))
86 |
87 | (defmethod listen [:window :restored]
88 | [c evt f]
89 | (event-listener-helper c evt f))
90 |
91 | (defmethod ignore [:window :restored]
92 | [c evt listener]
93 | (event-ignore-helper c evt listener))
94 |
--------------------------------------------------------------------------------
/src/clj/lab/ui/templates.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.templates
2 | (:require [lab.util :refer [index-of]]
3 | [lab.ui.core :as ui]
4 | [lab.model.document :as doc]))
5 |
6 | (defn close-tab
7 | "Expects the source of the event to have a :tab-id key in its :stuff."
8 | [{:keys [app source] :as e}]
9 | (let [ui (:ui @app)
10 | id (:tab-id (ui/stuff source))
11 | tab (ui/find @ui (ui/id= id))]
12 | (ui/update! ui (ui/parent id) ui/remove tab)))
13 |
14 | (defn- resolve-close-tab
15 | [{:keys [app source] :as e}]
16 | (let [ui (:ui @app)
17 | id (:tab-id (ui/stuff source))
18 | tab (ui/find @ui (ui/id= id))
19 | close-tab (or (:close-tab (ui/stuff tab)) close-tab)]
20 | (when close-tab
21 | (close-tab e))))
22 |
23 | (defn select-tab
24 | [tabs id]
25 | (ui/selection tabs
26 | (index-of (ui/children tabs)
27 | (ui/find tabs (ui/id= id)))))
28 |
29 | (defn- select-tab-click
30 | "Selects the tab that generated the event."
31 | [{:keys [app source] :as e}]
32 | (let [ui (:ui @app)
33 | id (:tab-id (ui/stuff source))]
34 | (ui/update! ui (ui/parent id) select-tab id)))
35 |
36 | (defn- tab-click
37 | [e]
38 | (case (:button e)
39 | :button-1 (select-tab-click e)
40 | :button-2 (resolve-close-tab e)
41 | :button-3 nil))
42 |
43 | (defn tab
44 | "Creates a tab with a tab header as a panel that
45 | includes a label and a closing button."
46 | ([]
47 | (tab (ui/genid)))
48 | ([id]
49 | (ui/init
50 | [:tab {:id id
51 | :header [:panel {:background 0x333333
52 | :stuff {:tab-id id}
53 | :listen [:click ::tab-click]}
54 | [:label {:color 0xFFFFFF}]
55 | [:button {:icon "close-tab.png"
56 | :border :none
57 | :padding 0
58 | :transparent true
59 | :listen [:click ::resolve-close-tab]
60 | :stuff {:tab-id id}}]]}])))
61 |
62 | (defn confirm
63 | [title message owner]
64 | (-> [:option-dialog {:owner owner
65 | :title title
66 | :message message
67 | :options :yes-no-cancel
68 | :visible true}]
69 | ui/init
70 | (ui/attr :result)))
71 |
72 | (defn save-file-dialog
73 | [dir owner]
74 | [:file-dialog {:owner owner
75 | :type :save
76 | :visible true
77 | :current-dir dir}])
78 |
79 | (defn open-file-dialog
80 | [dir owner]
81 | [:file-dialog {:owner owner
82 | :type :open
83 | :visible true
84 | :current-dir dir}])
85 |
86 | (defn directory-dialog
87 | [title dir owner]
88 | [:file-dialog {:owner owner
89 | :type :open,
90 | :selection-type :dir-only,
91 | :visible true,
92 | :title title
93 | :current-dir dir}])
94 |
--------------------------------------------------------------------------------
/src/clj/lab/ui/util.clj:
--------------------------------------------------------------------------------
1 | (ns lab.ui.util)
2 |
3 | (defn int-to-rgb
4 | "Converts a single int value int a RGB triple."
5 | [n]
6 | (let [r (-> n (bit-and 0xFF0000) (bit-shift-right 16))
7 | g (-> n (bit-and 0x00FF00) (bit-shift-right 8))
8 | b (-> n (bit-and 0x0000FF))]
9 | {:r r :g g :b b}))
10 |
11 | (defn rgb-to-int
12 | "Converts a RGB triple to a single int value."
13 | [{:keys [r g b]}]
14 | (int (+ (* r 65536) (* g 256) b)))
15 |
16 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
17 | ;; Convenience macros for multimethod implementations
18 |
19 | (defmacro definitializations
20 | "Generates all the multimethod implementations
21 | for each of the entries in the map destructured
22 | from its args.
23 |
24 | :component-tag ClassName | init-fn"
25 | [& {:as m}]
26 | `(do
27 | ~@(for [[k c] m]
28 | (if (and (not (seq? c)) (-> c resolve class?))
29 | `(defmethod lab.ui.protocols/initialize ~k [c#]
30 | (new ~c))
31 | `(defmethod lab.ui.protocols/initialize ~k [x#]
32 | (~c x#))))))
33 |
34 | (defmacro defattributes
35 | "Convenience macro to define attribute setters for each component type.
36 |
37 | The method implemented returns the first argument (which is the component
38 | itself), UNLESS the `^:modify` metadata flag is true for the argument vector,
39 | in which case the value from the last expression in the body is returned.
40 |
41 | *attrs-declaration
42 |
43 | Where each attrs-declaration is:
44 |
45 | component-tag *attr-declaration
46 |
47 | And each attr-declaration is:
48 |
49 | (attr-name [c attr v] & body)"
50 | [& body]
51 | (let [comps (->> body
52 | (partition-by keyword?)
53 | (partition 2)
54 | (map #(apply concat %)))
55 | f (fn [tag & mthds]
56 | (for [[attr [c _ _ :as args] & body] mthds]
57 | (let [x (gensym)]
58 | (assert (not= c '_) "First arg symbol can't be _")
59 | `(defmethod lab.ui.protocols/set-attr [~tag ~attr]
60 | ~args
61 | (let [~x (do ~@body)]
62 | ~(if (-> args meta :modify) x c))))))]
63 | `(do ~@(mapcat (partial apply f) comps))))
64 |
--------------------------------------------------------------------------------
/src/clj/lab/util.clj:
--------------------------------------------------------------------------------
1 | (ns lab.util
2 | (:require [clojure.core.async :as async]
3 | [clojure.core.async.impl.protocols :as async-protocols]
4 | [clojure [string :as str]
5 | [reflect :as r]
6 | [pprint :as p]]
7 | [clojure.java.io :as io])
8 | (:import [java.io File]))
9 |
10 | (defn channel?
11 | [x]
12 | (satisfies? async-protocols/Channel x))
13 |
14 | (defn timeout-channel
15 | "Creates a go block that works in two modes :wait and :recieve.
16 | When on ':wait' it blocks execution until a value is recieved
17 | from the channel, it then enters ':recieve' mode until the timeout
18 | wins. Returns a channel that takes the input events."
19 | [timeout-ms f]
20 | (let [c (async/chan)]
21 | (async/go-loop [mode :wait
22 | args nil]
23 | (condp = mode
24 | :wait
25 | (recur :recieve (async/ s
37 | .toLowerCase
38 | (.replace " " "-")
39 | keyword))
40 |
41 | (defn- kw->fn [k]
42 | (or (-> k str (subs 1) symbol resolve)
43 | (throw (Exception. (str "The keyword " k " does not resolve to a var.")))))
44 |
45 | (def memoized-kw->fn (memoize kw->fn))
46 |
47 | (defn find-limits
48 | "Returns a lazy sequence of vectors with the
49 | limits of the matches found in the string
50 | by the regex or the Matcher provided."
51 | ([^String ptrn ^String s]
52 | (let [m (re-matcher (re-pattern ptrn) s)]
53 | (find-limits m)))
54 | ([^java.util.regex.Matcher m]
55 | (lazy-seq
56 | (when-let [lim (when (.find m) [(.start m) (.end m)])]
57 | (cons lim (find-limits m))))))
58 |
59 | (defn find-char
60 | "Finds the next char in s for which pred is true,
61 | starting to look from position i, stepping through the
62 | positions determined by the application of the step function.
63 | Returns the index if found or nil otherwise."
64 | [s i pred step]
65 | (cond (or (neg? i) (<= (count s) i)) nil
66 | (pred (get s i)) i
67 | :else (recur s (step i) pred step)))
68 |
69 | (defn remove-at
70 | "Removes the element in the ith position from the given vector."
71 | [v i]
72 | (vec (concat (subvec v 0 i) (subvec v (inc i) (count v)))))
73 |
74 | (defn index-of
75 | "Takes a vector and returns the index of x."
76 | [^clojure.lang.PersistentVector v x]
77 | (.indexOf v x))
78 |
79 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
80 | ;; File Utils
81 |
82 | (defn same-file?
83 | "Checks if the two files supplied are the same."
84 | [^File x ^File y]
85 | (when (and x y)
86 | (= (.getCanonicalPath x) (.getCanonicalPath y))))
87 |
88 | (defn locate-file
89 | "Takes a filename and a string containing a concatenated
90 | list of directories, looks for the file in each dir and
91 | returns it if found."
92 | [filename paths]
93 | (->> (str/split paths (re-pattern (File/pathSeparator)))
94 | (map #(as-> (str % (File/separator) filename) path
95 | (when (.exists (io/file path)) path)))
96 | (filter identity)
97 | first))
98 |
99 | (defn locate-dominating-file
100 | "Look up the directory hierarchy from FILE for a file named NAME.
101 | Stop at the first parent directory containing a file NAME,
102 | and return the directory. Return nil if not found."
103 | [path filename]
104 | (loop [path path]
105 | (let [filepath (str path (File/separator) filename)
106 | file (io/file filepath)
107 | parent (.getParent file)]
108 | (cond
109 | (.exists file)
110 | filepath
111 | (-> parent nil? not)
112 | (recur parent)))))
113 |
114 | (defn ensure-dir
115 | "Takes a path and if it corresponds to a file returns the
116 | path to its parent directory, otherwise it returns the paht itself."
117 | [path]
118 | (let [file (io/file path)]
119 | (if (.isDirectory file)
120 | path
121 | (.getParent file))))
122 |
123 | (defn relativize
124 | "Takes two files (or absolute paths) and returns the relative path
125 | if the second argument is a child of the first one."
126 | [parent child]
127 | (let [result (-> (io/file parent)
128 | .toURI
129 | (.relativize (.toURI (io/file child)))
130 | .getPath)]
131 | (if (.exists (io/file (str parent "/" result)))
132 | result
133 | child)))
134 |
135 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
136 | ;; Exception
137 |
138 | (defn stacktrace->str [^Exception ex]
139 | (let [sw (java.io.StringWriter.)]
140 | (.printStackTrace ex (java.io.PrintWriter. sw))
141 | (str sw)))
142 |
--------------------------------------------------------------------------------
/src/java/lab/ui/swing/LineHighlighter.java:
--------------------------------------------------------------------------------
1 | package lab.ui.swing;
2 |
3 | import java.awt.*;
4 | import java.awt.event.*;
5 | import javax.swing.*;
6 | import javax.swing.event.*;
7 | import javax.swing.text.*;
8 |
9 | /*
10 | * Track the movement of the Caret by painting a background line at the
11 | * current caret position.
12 | */
13 | public class LineHighlighter
14 | implements Highlighter.HighlightPainter, CaretListener, MouseListener, MouseMotionListener
15 | {
16 | private JTextComponent component;
17 |
18 | private Color color;
19 |
20 | private Rectangle lastView;
21 |
22 | /*
23 | * The line color will be calculated automatically by attempting
24 | * to make the current selection lighter by a factor of 1.2.
25 | *
26 | * @param component text component that requires background line painting
27 | */
28 | public LineHighlighter(JTextComponent component)
29 | {
30 | this(component, null);
31 | setLighter(component.getSelectionColor());
32 | }
33 |
34 | /*
35 | * Manually control the line color
36 | *
37 | * @param component text component that requires background line painting
38 | * @param color the color of the background line
39 | */
40 | public LineHighlighter(JTextComponent component, Color color)
41 | {
42 | this.component = component;
43 | setColor( color );
44 |
45 | // Add listeners so we know when to change highlighting
46 |
47 | component.addCaretListener( this );
48 | component.addMouseListener( this );
49 | component.addMouseMotionListener( this );
50 |
51 | // Turn highlighting on by adding a dummy highlight
52 |
53 | try
54 | {
55 | component.getHighlighter().addHighlight(0, 0, this);
56 | }
57 | catch(BadLocationException ble) {}
58 | }
59 |
60 | /*
61 | * You can reset the line color at any time
62 | *
63 | * @param color the color of the background line
64 | */
65 | public void setColor(Color color)
66 | {
67 | this.color = color;
68 | }
69 |
70 | /*
71 | * Calculate the line color by making the selection color lighter
72 | *
73 | * @return the color of the background line
74 | */
75 | public void setLighter(Color color)
76 | {
77 | int red = Math.min(255, (int)(color.getRed() * 0.4));
78 | int green = Math.min(255, (int)(color.getGreen() * 0.4));
79 | int blue = Math.min(255, (int)(color.getBlue() * 0.4));
80 | setColor(new Color(red, green, blue));
81 | }
82 |
83 | // Paint the background highlight
84 |
85 | public void paint(Graphics g, int p0, int p1, Shape bounds, JTextComponent c)
86 | {
87 | try
88 | {
89 | Rectangle r = c.modelToView(c.getCaretPosition());
90 | g.setColor( color );
91 | g.fillRect(0, r.y, c.getWidth(), r.height);
92 |
93 | if (lastView == null)
94 | lastView = r;
95 | }
96 | catch(BadLocationException ble) {System.out.println(ble);}
97 | }
98 |
99 | /*
100 | * Caret position has changed, remove the highlight
101 | */
102 | private void resetHighlight()
103 | {
104 | // Use invokeLater to make sure updates to the Document are completed,
105 | // otherwise Undo processing causes the modelToView method to loop.
106 |
107 | SwingUtilities.invokeLater(new Runnable()
108 | {
109 | public void run()
110 | {
111 | try
112 | {
113 | int offset = component.getCaretPosition();
114 | Rectangle currentView = component.modelToView(offset);
115 |
116 | // Remove the highlighting from the previously highlighted line
117 | if (lastView != null && lastView.y != currentView.y)
118 | {
119 | component.repaint(0, lastView.y, component.getWidth(), lastView.height);
120 | lastView = currentView;
121 | }
122 | }
123 | catch(BadLocationException ble) {}
124 | }
125 | });
126 | }
127 |
128 | // Implement CaretListener
129 |
130 | public void caretUpdate(CaretEvent e)
131 | {
132 | resetHighlight();
133 | }
134 |
135 | // Implement MouseListener
136 |
137 | public void mousePressed(MouseEvent e)
138 | {
139 | resetHighlight();
140 | }
141 |
142 | public void mouseClicked(MouseEvent e) {}
143 | public void mouseEntered(MouseEvent e) {}
144 | public void mouseExited(MouseEvent e) {}
145 | public void mouseReleased(MouseEvent e) {}
146 |
147 | // Implement MouseMotionListener
148 |
149 | public void mouseDragged(MouseEvent e)
150 | {
151 | resetHighlight();
152 | }
153 |
154 | public void mouseMoved(MouseEvent e) {}
155 | }
--------------------------------------------------------------------------------
/src/log4j.properties:
--------------------------------------------------------------------------------
1 | log4j.rootLogger=DEBUG, standard
2 |
3 | log4j.appender.standard = org.apache.log4j.RollingFileAppender
4 | log4j.appender.standard.File = logs/standard.log
5 | log4j.appender.standard.MaxFileSize=1MB
6 | log4j.appender.standard.MaxBackupIndex=1
7 |
8 | log4j.appender.standard.layout=org.apache.log4j.PatternLayout
9 | log4j.appender.standard.layout.ConversionPattern=%d [%t] %-5p %c %x - %m%n
--------------------------------------------------------------------------------
/test/lab/test/core.clj:
--------------------------------------------------------------------------------
1 | (ns lab.test.core
2 | (:use [lab.core :reload true]
3 | [lab.test :only [->test ->is]]
4 | [clojure.test :only [deftest is run-tests use-fixtures]])
5 | (:require [clojure.java.io :as io]
6 | [lab.model.document :as doc :reload true]))
7 |
8 | (declare delete-file create-file tmp-files)
9 |
10 | (defn temp-document-config
11 | "Fixture that creates some temp files and sets
12 | the new document counter to 0."
13 | [f]
14 | (try
15 | (binding [doc/*untitled-count* (atom 0)]
16 | (dorun (map (partial create-file "Temp file, should be deleted.") tmp-files))
17 | (f))
18 | (finally
19 | (dorun (map delete-file tmp-files)))))
20 |
21 | (use-fixtures :once temp-document-config)
22 |
23 | (deftest init-app
24 | (->test
25 | default-app
26 | (->is not= nil)
27 | (->is not= nil :documents)
28 | (->is = nil :current-document)))
29 |
30 | (deftest document-operations
31 | (->test
32 | default-app
33 |
34 | (->is = 0 (comp count :documents))
35 | (->is = nil current-document)
36 |
37 | (new-document)
38 | (->is = 1 (comp count :documents))
39 | (->is not= nil current-document)
40 | (->is = "Untitled 1" (comp :name deref current-document))
41 |
42 | (new-document)
43 | (->is = 2 (comp count :documents))
44 | (->is = "Untitled 2" (comp :name deref current-document))
45 |
46 | (as-> x (switch-document x (find-doc-by-name x "Untitled 1")))
47 | (->is = "Untitled 1" (comp :name deref current-document))
48 |
49 | (as-> x (close-document x (find-doc-by-name x "Untitled 1")))
50 | (->is = 1 (comp count :documents))
51 | (->is = nil current-document)
52 |
53 | (open-document "./tmp")
54 | (->is = 2 (comp count :documents))
55 | (->is not= nil current-document)
56 | (->is = "tmp" (comp :name deref current-document))
57 |
58 | (open-document "../tmp")
59 | (->is = 3 (comp count :documents))
60 | (->is not= nil current-document)
61 | (->is = "tmp" (comp :name deref current-document))
62 |
63 | ; Open the same file with different paths
64 | ; and check it's still 3 documents.
65 | (open-document ".././tmp")
66 | (->is = 3 (comp count :documents))
67 |
68 | (open-document "./../tmp")
69 | (->is = 3 (comp count :documents))
70 |
71 | (as-> x (switch-document x (find-doc-by-name x "tmp")))
72 | (is (instance? clojure.lang.Atom :current-document))))
73 |
74 | ;;------------------------------------
75 | ;; Helper functions
76 |
77 | (def tmp-files ["./tmp" "../tmp"])
78 |
79 | (defn delete-file
80 | "Deletes a file if it exists."
81 | [path]
82 | (when (-> path io/file .exists)
83 | (io/delete-file path)))
84 |
85 | (defn create-file
86 | "Creates a file with the supplied content."
87 | [content path]
88 | (spit path content))
89 |
90 |
--------------------------------------------------------------------------------
/test/lab/test/core/dummy_local_plugin.clj:
--------------------------------------------------------------------------------
1 | (ns lab.test.core.dummy-local-plugin
2 | (:require [lab.core :as lab]
3 | [lab.test.core.plugin :refer [hooked hook]]
4 | [lab.core.keymap :as km]
5 | [lab.core.plugin :refer [defplugin]]))
6 |
7 | (defplugin lab.test.core.dummy-local-plugin
8 | :type :local
9 | :keymaps [(km/keymap :dummy-local
10 | :local
11 | {:fn :fn :keystroke "ctrl o"})]
12 | :hooks {#'hooked #'hook}
13 | :init! (fn [app] (swap! (lab/current-document @app) assoc :init? true))
14 | :unload! (fn [app] (swap! (lab/current-document @app) dissoc :init?)))
--------------------------------------------------------------------------------
/test/lab/test/core/dummy_plugin.clj:
--------------------------------------------------------------------------------
1 | (ns lab.test.core.dummy-plugin
2 | (:require [lab.test.core.plugin :refer [hooked hook]]
3 | [lab.core.keymap :as km]
4 | [lab.core.plugin :refer [defplugin]]))
5 |
6 | (defplugin lab.test.core.dummy-plugin
7 | :type :global
8 | :keymaps [(km/keymap :dummy-global
9 | :global
10 | {:fn :fn :keystroke "ctrl o"})
11 | (km/keymap :dummy-lang
12 | :lang :plain-text
13 | {:fn :fn :keystroke "ctrl o"})
14 | (km/keymap :dummy-local
15 | :local
16 | {:fn :fn :keystroke "ctrl o"})]
17 | :hooks {#'hooked #'hook}
18 | :init! (fn [app] (swap! app assoc :init? true))
19 | :unload! (fn [app] (swap! app dissoc :init?)))
--------------------------------------------------------------------------------
/test/lab/test/core/keymap.clj:
--------------------------------------------------------------------------------
1 | (ns lab.test.core.keymap
2 | (:refer-clojure :exclude [remove find])
3 | (:require [clojure.test :refer [deftest is run-tests]]
4 | [lab.core.keymap :as km :refer [append remove keymap find commands]]))
5 |
6 | (def global (keymap :global-keymap :global
7 | {:fn :*-global :keystroke "ctrl *"}))
8 |
9 | (def lang (keymap :lang-keymap :lang :plain-text
10 | {:fn :ctrl-a-lang :keystroke "ctrl a"}
11 | {:fn :ctrl-b-lang :keystroke "ctrl b"}))
12 |
13 | (def local (keymap :local-keymap :local
14 | {:fn :ctrl-a-local :keystroke "ctrl a"}
15 | {:fn :alt-a-local :keystroke "alt a"}
16 | {:fn :alt-a-local :keystroke "alt l"}))
17 |
18 | (deftest creation
19 | (is (= :global (:type global)))
20 | (is (= :global-keymap (:name global)))
21 | (is (= 1 (-> global :bindings count)))
22 |
23 | (is (= :lang (:type lang)))
24 | (is (= :lang-keymap (:name lang)))
25 | (is (= 2 (-> lang :bindings count)))
26 | (is (= :plain-text (:lang lang )))
27 |
28 | (is (= :local (:type local)))
29 | (is (= :local-keymap (:name local)))
30 | (is (= 3 (-> local :bindings count))))
31 |
32 | (deftest append-and-find
33 | (let [global-lang (append global lang)
34 | global-lang-local (append global-lang local)
35 | ctrl-a (#'km/ks->set "ctrl a")
36 | alt-a (#'km/ks->set "alt a")
37 | ctrl-b (#'km/ks->set "ctrl b")]
38 |
39 | (is (nil? (:fn (find global ctrl-a))))
40 | (is (nil? (:fn (find global ctrl-b))))
41 |
42 | (is (= :ctrl-a-lang (:fn (find global-lang ctrl-a))))
43 | (is (= :ctrl-b-lang (:fn (find global-lang ctrl-b))))
44 |
45 | (is (= :ctrl-a-local (:fn (find global-lang-local ctrl-a))))
46 | (is (= :alt-a-local (:fn (find global-lang-local alt-a))))
47 | (is (= :ctrl-b-lang (:fn (find global-lang-local ctrl-b))))))
48 |
49 | (deftest remove-and-find
50 | (let [global-lang-local (-> global (append lang) (append local))
51 | global-lang (remove global-lang-local (:id local))
52 | global-local (remove global-lang-local (:id lang))
53 | lang-local (remove global-lang-local (:id global))
54 | empty-km (remove lang (:id lang))
55 | ctrl-* (#'km/ks->set "ctrl *")
56 | ctrl-a (#'km/ks->set "ctrl a")
57 | ctrl-b (#'km/ks->set "ctrl b")
58 | alt-a (#'km/ks->set "alt a")]
59 | (is (nil? (find global-lang alt-a)))
60 | (is (= :ctrl-a-lang (:fn (find global-lang ctrl-a))))
61 |
62 | (is (nil? (find global-local ctrl-b)))
63 | (is (= :ctrl-a-local (:fn (find global-local ctrl-a))))
64 |
65 | (is (nil? (find lang-local ctrl-*)))
66 |
67 | (is (nil? empty-km))))
68 |
69 | (deftest get-commands
70 | (let [global-lang-local (-> global (append lang) (append local))
71 | result {:global-keymap #{{:fn :*-global :keystroke "ctrl *"}}
72 | :lang-keymap #{{:fn :ctrl-b-lang :keystroke "ctrl b"}}
73 | :local-keymap #{{:fn :ctrl-a-local :keystroke "ctrl a"}
74 | {:fn :alt-a-local :keystroke "alt a"}
75 | {:fn :alt-a-local :keystroke "alt l"}}}]
76 | (is (= result (commands global-lang-local)))))
77 |
--------------------------------------------------------------------------------
/test/lab/test/core/plugin.clj:
--------------------------------------------------------------------------------
1 | (ns lab.test.core.plugin
2 | (:require [clojure.test :refer [deftest is run-tests testing]]
3 | [lab.core :as lab]
4 | [lab.core [keymap :as km]
5 | [plugin :refer [defplugin load-plugin! unload-plugin!]]]
6 | [lab.model.document :as doc]))
7 |
8 | ;;;;;;;;;;;;;;;;;;;;;
9 | ;; Default app atom
10 |
11 | (def app (atom lab/default-app))
12 |
13 | (defn hooked [x] :hooked)
14 | (defn hook [f x] :hook)
15 |
16 | ;;;;;;;;;;;;;;;;;;;;;
17 | ;; Tests
18 |
19 | (deftest load-and-unload-global-plugin
20 | (is (nil? (:keymap @app)))
21 | (is (= 0 (count (:plugins @app))))
22 | (is (nil? (-> @app :langs :plain-text :keymap (km/find #{"ctrl" "o"}))))
23 | (is (nil? (:init? @app)))
24 | (is (= :hooked (hooked 1)))
25 |
26 | (load-plugin! app 'lab.test.core.dummy-plugin)
27 | (is (:keymap @app))
28 | (is (= 1 (count (:plugins @app))))
29 | (is (= 'lab.test.core.dummy-plugin (-> @app :plugins first :name)))
30 | (is (-> @app :langs :plain-text :keymap (km/find #{"ctrl" "o"})))
31 | (is (:init? @app))
32 | (is (= :hook (hooked 1)))
33 |
34 | (testing "Load plugin twice, check single loading."
35 | (load-plugin! app 'lab.test.core.dummy-plugin)
36 | (is (= 1 (count (:plugins @app)))))
37 |
38 | (unload-plugin! app 'lab.test.core.dummy-plugin)
39 | (is (nil? (:keymap @app )))
40 | (is (= 0 (count (:plugins @app))))
41 | (is (nil? (-> @app :langs :plain-text :keymap (km/find #{"ctrl" "o"}))))
42 | (is (nil? (:init? @app)))
43 | (is (= :hooked (hooked 1))))
44 |
45 | (deftest load-and-unload-local-plugin
46 | (swap! app lab/new-document)
47 | (let [doc (lab/current-document @app)]
48 | (is (nil? (:keymap @doc)))
49 | (is (= 0 (count (:plugins @doc))))
50 | (is (nil? (km/find (:keymap @doc) #{"ctrl" "o"})))
51 | (is (nil? (:init? @doc)))
52 | (is (= :hooked (hooked 1)))
53 |
54 | (load-plugin! app 'lab.test.core.dummy-local-plugin)
55 | (is (:keymap @doc))
56 | (is (= 1 (count (:plugins @doc))))
57 | (is (= 'lab.test.core.dummy-local-plugin (-> @doc :plugins first :name)))
58 | (is (km/find (:keymap @doc) #{"ctrl" "o"}))
59 | (is (:init? @doc))
60 | (is (= :hook (hooked 1)))
61 |
62 | (testing "Load plugin twice, check single loading."
63 | (load-plugin! app 'lab.test.core.dummy-local-plugin)
64 | (is (= 1 (count (:plugins @doc)))))
65 |
66 | (unload-plugin! app 'lab.test.core.dummy-local-plugin)
67 | (is (nil? (:keymap @doc)))
68 | (is (= 0 (count (:plugins @doc))))
69 | (is (nil? (km/find (:keymap @doc) #{"ctrl" "o"})))
70 | (is (nil? (:init? @doc)))
71 | (is (= :hooked (hooked 1)))))
72 |
73 | (deftest plugin-definition
74 | (let [plugin (ns-resolve (the-ns 'lab.test.core.dummy-plugin) 'plugin)]
75 | (is plugin)
76 | (is (and (:keymaps @plugin)
77 | (:hooks @plugin)
78 | (:init! @plugin)
79 | (:unload! @plugin)))))
80 |
--------------------------------------------------------------------------------
/test/lab/test/model/document.clj:
--------------------------------------------------------------------------------
1 | (ns lab.test.model.document
2 | (:refer-clojure :exclude [replace])
3 | (:use clojure.test
4 | [lab.test :only [->test ->is]]
5 | lab.model.document)
6 | (:require [clojure.java.io :as io]
7 | [lab.core.lang :as lang]))
8 | ;---------------------------
9 | (def file-content "Temp file, should be deleted.")
10 | (def tmp-file "./tmp")
11 | (def default-lang lang/plain-text)
12 | ;---------------------------
13 | (defn temp-document-config
14 | [f]
15 | (try
16 | (binding [*untitled-count* (atom 0)]
17 | (spit tmp-file file-content) ; create temp file
18 | (f))
19 | (finally
20 | (when (-> tmp-file io/file .exists)
21 | (io/delete-file tmp-file)))))
22 | ;---------------------------
23 | (use-fixtures :each temp-document-config)
24 | ;---------------------------
25 | (deftest document-creation
26 | (is (= "Untitled 1" (:name (document default-lang))))
27 | (is (= "" (text (document default-lang)))))
28 | ;---------------------------
29 | (deftest document-manipulation
30 | (let [end "Oh yes, it will!"
31 | middle "Do you think so?"
32 | len (count file-content)]
33 | (->test
34 | ; Check new document properties
35 | (document default-lang)
36 | (->is = false :modified?)
37 | (->is = "" text)
38 | (->is = 0 length)
39 | (->is = "Untitled 1" :name)
40 |
41 | ; Bind the document to a file
42 | (bind tmp-file)
43 | (->is = false :modified?)
44 | (->is = file-content text)
45 | (->is = "tmp" :name)
46 |
47 | ; Append text to the document
48 | (append end)
49 | (->is = true :modified?)
50 | (->is = (str file-content end) text)
51 |
52 | ; Insert text in the middle
53 | (insert len middle)
54 | (->is = (str file-content middle end) text)
55 |
56 | ; Delete text from the middle
57 | (delete len (+ len (count middle)))
58 | (->is = (str file-content end) text)
59 |
60 | ; Save file, check file-content and modified
61 | (->is not= (slurp tmp-file) text)
62 | (save)
63 | (->is = (slurp tmp-file) text)
64 | (->is = false :modified?))))
65 | ;---------------------------
66 | (deftest bind-non-existing-file
67 | (is (= "bla" (-> (document default-lang) (bind "./bla") :name))))
68 | ;---------------------------
69 | (deftest search-and-replace
70 | (let [doc (append (document default-lang) "abc\nabc\nd")]
71 | ; Search
72 | (->test
73 | doc
74 | (search "b")
75 | (->is = [[1 2] [5 6]]))
76 | ; Replace
77 | (->test
78 | doc
79 | (replace "b" "1")
80 | (->is = "a1c\na1c\nd" text)
81 | (replace "1" "bla")
82 | (->is = "ablac\nablac\nd" text)
83 | (replace "blac" "bc")
84 | (->is = "abc\nabc\nd" text))))
85 | ;---------------------------
86 | (deftest undo-redo
87 | (->test (document default-lang)
88 | ;; Undo in an empty history
89 | (undo)
90 | ;; Redo in an empty history
91 | (redo)
92 |
93 | (append "abc\nabc\nd")
94 | ; undo/redo replace
95 | (replace "b" "1")
96 | (replace "1" "bla")
97 | (undo)
98 | (->is = "a1c\na1c\nd" text)
99 | (undo)
100 | (->is = "abc\nabc\nd" text)
101 | (redo)
102 | (->is = "a1c\na1c\nd" text)
103 | (redo)
104 | (->is = "ablac\nablac\nd" text)
105 |
106 | ; undo/redo delete
107 | (delete 0 4)
108 | (->is = "c\nablac\nd" text)
109 | (undo)
110 | (->is = "ablac\nablac\nd" text)
111 | (redo)
112 | (->is = "c\nablac\nd" text)
113 |
114 | ; undo/redo insert
115 | (insert 1 "ba")
116 | (->is = "cba\nablac\nd" text)
117 | (undo)
118 | (->is = "c\nablac\nd" text)
119 | (redo)
120 | (->is = "cba\nablac\nd" text)))
121 | ;---------------------------
122 |
--------------------------------------------------------------------------------
/test/lab/test/model/history.clj:
--------------------------------------------------------------------------------
1 | (ns lab.test.model.history
2 | (:refer-clojure :exclude [name replace])
3 | (:use [clojure.test :only [deftest testing is run-tests]]
4 | [lab.test :only [->test ->is]]
5 | [lab.model.history :only [history add current rewind forward]]))
6 |
7 | (deftest history-operations
8 | (->test (history)
9 | (add :a)
10 | (->is = :a current)
11 | (add :b)
12 | (add :c)
13 | (->is = :c current)
14 | (add :d)
15 | rewind
16 | (->is = :c current)
17 | rewind
18 | (->is = :b current)
19 | rewind
20 | (->is = :a current)
21 | rewind
22 | (->is = nil current)
23 | forward
24 | forward
25 | (->is = :b current)
26 | forward
27 | forward
28 | (->is = :d current)
29 | forward
30 | (->is = nil current)))
31 |
--------------------------------------------------------------------------------
/test/lab/test/ui.clj:
--------------------------------------------------------------------------------
1 | (ns lab.test.ui
2 | (:refer-clojure :exclude [find remove])
3 | (:use lab.ui.core
4 | [clojure.test :only [deftest is are run-tests testing]]))
5 |
6 | (def tab1 [:tab {:id "2"}])
7 | (def tab2 [:tab {:id "3"}])
8 |
9 | (def ts [:tabs {:id "0"} tab1 tab2])
10 |
11 | (def tr [:tree {:id "1"}])
12 |
13 | (def ui-test (#'lab.ui.core/hiccup->component [:window ts tr]))
14 |
15 | (deftest find-in-ui
16 | (testing "Find by id"
17 | (are [x y] (= x (-> ui-test (find y) (attr :id)))
18 | "0" :#0
19 | "2" :#2
20 | "1" :#1
21 | nil :#9)))
22 |
23 | (deftest update-ui
24 | (testing "Udpate by id"
25 | (is (= (assoc-in ui-test [:content 0 :content 1 :attrs :bla] 1)
26 | (update ui-test :#3 attr :bla 1)))))
27 |
--------------------------------------------------------------------------------
/test/lab/test/ui/select.clj:
--------------------------------------------------------------------------------
1 | (ns lab.test.ui.select
2 | (:require [lab.ui.core :as ui])
3 | (:use [lab.ui.select :reload true]
4 | [clojure.test :only [deftest is are run-tests testing]]))
5 |
6 | (def attr-spec @#'ui/attr-spec)
7 |
8 | (def root (#'lab.ui.core/hiccup->component
9 | [:window {:id "main"
10 | :attr [:text-area {:id "text1"}]}
11 | [:label {:id "1"
12 | :size [100 100]}]
13 | [:button {:id "2"
14 | :class "two"
15 | :attr [:text-area {:id "text2"}]}
16 | [:combo {:id "combo"
17 | :size [100 200]
18 | :attr [:panel [:button]]}
19 | [:button {:class "no-number"}]
20 | [:text]]]
21 | [:label {:id "3"
22 | :size [100 100]}]
23 | [:tabs [:tab] [:tab] [:tab]]
24 | [:panel [:button]]]))
25 |
26 | (deftest ui-selection []
27 | (testing "single"
28 | (are [x y] (= x (select root y))
29 | [] :window
30 | [] :#main
31 | [:content 0] :label
32 | [:content 0] :#1
33 | [:content 1] :button
34 | [:content 1] :#2
35 | [:content 1 :content 0] :#combo
36 | [:content 1 :content 0] :combo
37 | nil :#not-found
38 | nil :not-found
39 | [:content 0] (attr? :size)
40 | nil (attr? :something)
41 | [:content 0] (attr= :size [100 100])
42 | [:content 1 :content 0] (attr= :size [100 200])))
43 |
44 | (testing "Chained"
45 | (are [x y] (= x (select root y))
46 | nil nil
47 | [] []
48 | [:content 0] [:window :label]
49 | [:content 1] [:#main :#2]
50 | [:content 1 :content 0] [:button :combo]
51 | [:content 1 :content 0] [:window :button :combo]
52 | [:content 1 :content 0 :content 1] [:button :combo :text]
53 | nil [:button :label]))
54 |
55 | (testing "Conjunction (and)"
56 | (are [x y] (= x (select root y))
57 | [] [[:window :#main]]
58 | nil [[:window :label]]
59 | [:content 0] [[:label :label]]))
60 |
61 | (testing "Disjunction (or)"
62 | (are [x y] (= x (select root y))
63 | [] #{:window :label}
64 | nil #{:x :y}
65 | [:content 0] #{:label :button}))
66 |
67 | (testing "Class selector"
68 | (are [x y] (= x (select root y))
69 | [:content 1] [[:button :.two]]
70 | [:content 1] :button.two
71 | [:content 1] :.two
72 | [:content 1] :#2.two
73 | [:content 1 :content 0 :content 0] :.no-number)))
74 |
75 | (deftest ui-select-all []
76 | (are [x y] (= x (select-all root y))
77 | nil nil
78 | #{[]} []
79 | #{[:content 0] [:content 2]} :label
80 | #{[:content 3 :content 0] [:content 3 :content 1] [:content 3 :content 2]} :tab
81 | #{[]} :window
82 | #{[] [:content 0] [:content 2]} #{:window :label}
83 | #{[] [:content 1] [:content 1 :content 0]} #{:window (attr? :attr)}))
84 |
85 | (deftest ui-select-all-with-spec []
86 | (are [x y] (= x (select-all root y attr-spec))
87 | nil nil
88 | #{} :does-not-exist
89 | #{[]} []
90 | #{[]} :#main
91 | #{[]} :window
92 | #{[:content 0] [:content 2]} :label
93 | #{[:content 3 :content 0] [:content 3 :content 1] [:content 3 :content 2]} :tab
94 | #{[:attrs :attr]} :#text1
95 | #{[:content 1 :attrs :attr]} :#text2
96 | #{[:content 1 :attrs :attr] [:attrs :attr]} :text-area
97 | #{[:content 1 :content 0 :attrs :attr :content 0] [:content 4 :content 0]} [:panel :button]))
98 |
--------------------------------------------------------------------------------