├── extensions ├── menu │ ├── icon-bar.menu.ss │ └── bar.menu.ss ├── shell │ └── terminal.ss ├── scheme │ ├── scheme.syntax.ss │ ├── scheme.snippets.ss │ └── scheme.complete.ss ├── tree │ └── file.tree.ss ├── themes │ ├── dracula.theme.ss │ └── light.theme.ss ├── keys │ └── edit.key.ss ├── extension.ss └── duck │ └── editor.duck.ss ├── resources ├── about.png ├── chat.png ├── copy.png ├── exit.png ├── find.png ├── open.png ├── paste.png ├── redo.png ├── save.png ├── shell.png ├── undo.png ├── folder.png ├── manual.png ├── replace.png ├── file-text.png ├── perffernce.png └── folder-open.png ├── data └── screenshot │ ├── demo1.jpg │ ├── demo2.png │ ├── demo3.jpg │ ├── demo4.jpg │ └── demo5.jpg ├── .gitignore ├── .duck.ss ├── README.zh_cn.md ├── README.md ├── app.ss └── LICENSE /extensions/menu/icon-bar.menu.ss: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /resources/about.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/about.png -------------------------------------------------------------------------------- /resources/chat.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/chat.png -------------------------------------------------------------------------------- /resources/copy.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/copy.png -------------------------------------------------------------------------------- /resources/exit.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/exit.png -------------------------------------------------------------------------------- /resources/find.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/find.png -------------------------------------------------------------------------------- /resources/open.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/open.png -------------------------------------------------------------------------------- /resources/paste.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/paste.png -------------------------------------------------------------------------------- /resources/redo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/redo.png -------------------------------------------------------------------------------- /resources/save.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/save.png -------------------------------------------------------------------------------- /resources/shell.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/shell.png -------------------------------------------------------------------------------- /resources/undo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/undo.png -------------------------------------------------------------------------------- /resources/folder.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/folder.png -------------------------------------------------------------------------------- /resources/manual.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/manual.png -------------------------------------------------------------------------------- /resources/replace.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/replace.png -------------------------------------------------------------------------------- /resources/file-text.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/file-text.png -------------------------------------------------------------------------------- /resources/perffernce.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/perffernce.png -------------------------------------------------------------------------------- /data/screenshot/demo1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/data/screenshot/demo1.jpg -------------------------------------------------------------------------------- /data/screenshot/demo2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/data/screenshot/demo2.png -------------------------------------------------------------------------------- /data/screenshot/demo3.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/data/screenshot/demo3.jpg -------------------------------------------------------------------------------- /data/screenshot/demo4.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/data/screenshot/demo4.jpg -------------------------------------------------------------------------------- /data/screenshot/demo5.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/data/screenshot/demo5.jpg -------------------------------------------------------------------------------- /resources/folder-open.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/evilbinary/duck-editor/master/resources/folder-open.png -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.ss~ 2 | *.ss#* 3 | .#*.ss 4 | 5 | *.scm~ 6 | *.scm#* 7 | .#*.scm 8 | .DS_Store 9 | *.db 10 | -------------------------------------------------------------------------------- /extensions/shell/terminal.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;Copyright 2016-2080 evilbinary. 3 | ;作者:evilbinary on 12/24/16. 4 | ;邮箱:rootdebug@163.com 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | (import (extensions extension)) 7 | (import duck.browser duck.tree duck.file duck.menu) 8 | 9 | (register 'shell.bar (lambda (duck) 10 | (let ((editor (get-var duck 'editor)) 11 | (file-tree (get-var duck 'tree )) 12 | (header (get-var duck 'menu )) 13 | (tree-scroll (get-var duck 'tree.scroll )) 14 | (work-dir (get-var duck 'work.dir )) 15 | ) 16 | (printf "termial loaded\n") 17 | ))) -------------------------------------------------------------------------------- /.duck.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;Copyright 2016-2080 evilbinary. 3 | ;作者:evilbinary on 12/24/16. 4 | ;邮箱:rootdebug@163.com 5 | ;;config file 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;;duck base 8 | (load-extension "duck/editor.duck.ss") 9 | 10 | ;;文件树 11 | (load-extension "tree/file.tree.ss") 12 | 13 | ;;语法高亮 14 | (load-extension "scheme/scheme.syntax.ss") 15 | 16 | ;;配色 17 | (load-extension "themes/dracula.theme.ss") 18 | ;;(load-extension "themes/light.theme.ss") 19 | 20 | ;;菜单 21 | (load-extension "menu/bar.menu.ss") 22 | 23 | ;;按键 24 | (load-extension "keys/edit.key.ss") 25 | 26 | ;;代码补全 27 | (load-extension "scheme/scheme.complete.ss") 28 | (load-extension "scheme/scheme.snippets.ss") 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /README.zh_cn.md: -------------------------------------------------------------------------------- 1 | # duck-editor 2 | 鸭子编辑器 [https://github.com/evilbinary/duck-editor](https://github.com/evilbinary/duck-editor) 3 | 基于scheme开发的，GPU渲染，高可扩展。 4 | 5 | [English Document](README.md) 6 | 7 | ## 特点 8 | 1. 比vscode快 9 | 2. 比emacs更灵活 10 | 11 | ## 加入 12 | 鸭编开发小组 群号:590540178 13 | 14 | ## 效果图 15 | 16 | 17 | 18 | 19 | ## 运行 20 | 基于[scheme lib](https://github.com/evilbinary/scheme-lib)库运行 21 | 进入bin目录，执行source env.sh，然后运行./scheme --script ../apps/duck-editor/duck-editor.ss 22 | ## 扩展 23 | 支持可扩展 24 | ### 已有扩展 25 | 1. scheme 语法高亮 26 | 2. dracula 主题 27 | 3. 文件管理 28 | 29 | ### 扩展开发 30 | #### 注册扩展 31 | ```scheme 32 | (import (extensions extension)) 33 | (register 'theme.dracula (lambda (duck) 34 | (let ((editor (get-var duck 'editor)) 35 | ;;扩展功能代码块 36 | )) 37 | ``` 38 | 39 | #### 按键定义处理 40 | ```scheme 41 | (set-key-map '(ctl a) (lambda() 42 | (printf "hook key ctl a\n") 43 | )) 44 | ``` 45 | 46 | ## 作者 47 | 48 | * evilbinary rootdebug@163.com 49 | * 个人博客 http://evilbinary.org 50 | 51 | ## 版权 52 | 53 | Copyright (c) evilbinary All rights reserved. 54 | 55 | Licensed under the [GPL](LICENSE.txt) license. 56 | 57 | 58 | -------------------------------------------------------------------------------- /extensions/scheme/scheme.syntax.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;Copyright 2016-2080 evilbinary. 3 | ;作者:evilbinary on 12/24/16. 4 | ;邮箱:rootdebug@163.com 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | (import (extensions extension)) 7 | 8 | (register 'syntax.scheme (lambda (duck) 9 | (let ((editor (get-var duck 'editor)) 10 | (syn (get-var duck 'syntax ))) 11 | ;;syntax here 12 | (let loop ((keywords (environment-symbols (scheme-environment)) )) 13 | (if (pair? keywords) 14 | (begin 15 | (add-keyword syn (symbol->string (car keywords)) ) 16 | (loop (cdr keywords))))) 17 | 18 | (add-keyword syn "if") 19 | (add-keyword syn "define") 20 | (add-keyword syn "import") 21 | (add-keyword syn "display") 22 | (add-keyword syn "set!") 23 | (add-keyword syn "def-function") 24 | (add-keyword syn "def-function-callback") 25 | (add-keyword syn "define-syntax") 26 | (add-keyword syn "begin") 27 | 28 | (add-identify syn "=") 29 | (add-identify syn "null?") 30 | (add-identify syn "#f") 31 | (add-identify syn "#t") 32 | (add-identify syn "'()") 33 | (add-keyword syn "let") 34 | (add-keyword syn "lambda") 35 | 36 | 37 | 38 | 39 | (widget-set-attrs editor 'syntax syn) 40 | (widget-set-attrs editor 'syntax-on #t) 41 | ))) -------------------------------------------------------------------------------- /extensions/tree/file.tree.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;Copyright 2016-2080 evilbinary. 3 | ;作者:evilbinary on 12/24/16. 4 | ;邮箱:rootdebug@163.com 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | (import (extensions extension)) 7 | (import duck.tree duck.file) 8 | 9 | (register 'tree.file-manager (lambda (duck) 10 | (let ((editor (get-var duck 'editor)) 11 | (file-tree (get-var duck 'tree )) 12 | (s0 (get-var duck 'tree.scroll )) 13 | (work-dir (get-var duck 'work.dir )) 14 | ) 15 | ;;here 16 | (init-tree-res) 17 | (if (null? file-tree ) 18 | (begin 19 | (set! file-tree (icon-tree 260.0 200.0 (string-append " " (path-last work-dir) ))) 20 | (set-var 'tree file-tree) 21 | (widget-set-attrs file-tree 'expanded #t) 22 | )) 23 | (if (null? work-dir) 24 | (make-file-tree file-tree "../") 25 | (make-file-tree file-tree work-dir)) 26 | 27 | (register-var-change 28 | 'work.dir 29 | (lambda (name val) 30 | (printf "val ~a change ~a\n" name val) 31 | (reload-file-tree file-tree val) 32 | )) 33 | (widget-add s0 file-tree) 34 | (widget-set-padding file-tree 40.0 20.0 20.0 20.0) 35 | 36 | (if (file-exists? (path-append work-dir "app.ss")) 37 | (widget-set-attr editor %text (readlines (path-append work-dir "app.ss") ) )) 38 | 39 | ))) -------------------------------------------------------------------------------- /extensions/themes/dracula.theme.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;Copyright 2016-2080 evilbinary. 3 | ;作者:evilbinary on 12/24/16. 4 | ;邮箱:rootdebug@163.com 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | (import (extensions extension)) 7 | 8 | (register 'theme.dracula (lambda (duck) 9 | (let ((editor (get-var duck 'editor)) 10 | (s0 (get-var duck 'tree.scroll )) 11 | (s1 (get-var duck 'editor.scroll )) 12 | (syn (get-var duck 'syntax )) 13 | (file-tree (get-var duck 'tree )) 14 | (menu (get-var duck 'menu )) 15 | ) 16 | ;;dracula theme 17 | (add-color syn 'identify #xffffb86c) 18 | (add-color syn 'number #xffbd93f9) 19 | (add-color syn 'comment #xff6272a4) 20 | (add-color syn 'string #xfff1fa8c) 21 | (add-color syn 'keyword #xffff79c6) 22 | (add-color syn 'normal #xfff8f8f2) 23 | (widget-set-attrs editor 'show-no 1) 24 | (widget-set-attrs editor 'lineno-color #xff6272a4) 25 | (widget-set-attrs editor 'select-color #xff44475a) 26 | (widget-set-attrs editor 'cursor-color #xfff8f8f0) 27 | (widget-set-attrs s0 'show-scroll #f) 28 | (widget-set-attrs s0 'background #x282a36) 29 | (widget-set-attrs s1 'background #x282a36) 30 | ;;(widget-set-attrs editor 'font "Roboto-Regular.ttf") 31 | (widget-set-attrs menu 'hover-background #xee3D3D3D) 32 | (widget-set-attrs menu 'background #xee3D3D3D) 33 | (widget-set-attrs editor 'font-size 18.0) 34 | (widget-set-attrs editor 'font-line-height 1.34) 35 | ))) -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Duck Editor 2 | Duck Editor [https://github.com/evilbinary/duck-editor](https://github.com/evilbinary/duck-editor) 3 | A Highly scalable Editor based on `scheme` with GPU rendering. 4 | 5 | [中文版说明文档](README.zh_cn.md) 6 | 7 | ## Features 8 | 1. Faster than [vscode](https://code.visualstudio.com/) 9 | 2. More flexible than [emacs](https://www.gnu.org/software/emacs/) 10 | 11 | ## Contributing 12 | Duck Editor Development Team `QQ Group Number: 590540178` 13 | 14 | ## Screen Shot 15 | 16 | 17 | 18 | 19 | ## Usage 20 | Based on [scheme lib](https://github.com/evilbinary/scheme-lib) 21 | ```bash 22 | ./scheme --script ../apps/duck-editor/duck-editor.ss 23 | ``` 24 | 25 | ## Extensions 26 | 27 | ### Extensions List 28 | 1. Scheme Grammar Highlights 29 | 2. dracula Theme 30 | 3. File System 31 | 32 | ### Develop Extensions 33 | #### Rigister Extension 34 | ```scheme 35 | (import (extensions extension)) 36 | (register 'theme.dracula (lambda (duck) 37 | (let ((editor (get-var duck 'editor)) 38 | ;; Code block for extension function. 39 | )) 40 | ``` 41 | 42 | #### Hook Key Control 43 | ```scheme 44 | (set-key-map '(ctl a) (lambda() 45 | (printf "hook key ctl a\n") 46 | )) 47 | ``` 48 | 49 | ## Author 50 | 51 | * evilbinary rootdebug@163.com 52 | * Blog http://evilbinary.org 53 | 54 | 55 | ## License 56 | 57 | Copyright (c) evilbinary All rights reserved. 58 | 59 | Licensed under the [GPL](LICENSE.txt) license. 60 | 61 | -------------------------------------------------------------------------------- /extensions/scheme/scheme.snippets.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;Copyright 2016-2080 evilbinary. 3 | ;作者:evilbinary on 12/24/16. 4 | ;邮箱:rootdebug@163.com 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | (import (extensions extension)) 7 | (import duck.snippets) 8 | (import scheme.complete) 9 | 10 | (register 'snippets.scheme (lambda (duck) 11 | (let ((editor (get-var duck 'editor)) 12 | (syn (get-var duck 'syntax )) 13 | (s1 (get-var duck 'editor.scroll )) 14 | ) 15 | (if (null? (get-var 'editor.snippets)) 16 | (let ((snippets (pop-snippets))) 17 | (widget-set-layout s1 free-layout) 18 | (set-var 'editor.snippets snippets) 19 | (widget-set-attr snippets %visible #f) 20 | (widget-add s1 snippets) 21 | )) 22 | (widget-add-event s1 23 | (lambda (w p type d) 24 | (if (= type %event-key) 25 | (let ((xy (widget-get-attrs editor 'cursor-xy ) )) 26 | '() 27 | (set-snippets-pos (list-ref xy 0) (+ 30.0 (list-ref xy 1))) 28 | 29 | (if (equal? '/ (get-default-key-map (vector-ref d 0))) 30 | (begin 31 | (printf "current text=~a\n" (find-previous-word (widget-get-attrs editor 'current-line-text))) 32 | (show-complete (find-previous-word (widget-get-attrs editor 'current-line-text))) 33 | )) 34 | ;;(printf "xy=~a\n" xy) 35 | )))) 36 | (register-var-change 'editor.snippets.text 37 | (lambda (name val) 38 | (printf "select ~a\n" val) 39 | ) 40 | ) 41 | 42 | 43 | '() 44 | ;;(show-snippets-pos 100.0 140.0) 45 | 46 | ))) 47 | 48 | 49 | -------------------------------------------------------------------------------- /extensions/themes/light.theme.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;Copyright 2016-2080 evilbinary. 3 | ;作者:evilbinary on 12/24/16. 4 | ;邮箱:rootdebug@163.com 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | (import (extensions extension)) 7 | 8 | (register 'theme.dracula (lambda (duck) 9 | (let ((editor (get-var duck 'editor)) 10 | (s0 (get-var duck 'tree.scroll )) 11 | (s1 (get-var duck 'editor.scroll )) 12 | (header (get-var duck 'menu )) 13 | (syn (get-var duck 'syntax ))) 14 | ;;ligth theme 15 | (add-color syn 'identify #xffffb86c) 16 | (add-color syn 'number #xffbd93f9) 17 | (add-color syn 'comment #xff6272a4) 18 | (add-color syn 'string #xfff1fa8c) 19 | (add-color syn 'keyword #xffff79c6) 20 | (add-color syn 'normal #xff333333) 21 | (add-color syn 'operator #xff333333) 22 | (register-var-change 23 | 'tree 24 | (lambda (name val) 25 | (widget-set-attrs val 'color #xff333333) 26 | )) 27 | ;;(widget-set-attr header %visible #f) 28 | 29 | (widget-set-attrs header 'color #xff333333) 30 | (widget-set-attrs header 'background #xfafafa) 31 | 32 | (widget-set-attrs editor 'select-color #xffb5d5fc) 33 | (widget-set-attrs editor 'cursor-color #xff333333) 34 | (widget-set-attrs editor 'color #xff333333) 35 | (widget-set-attrs editor 'show-no 1) 36 | (widget-set-attrs editor 'lineno-color #xff6272a4) 37 | 38 | (widget-set-attrs s0 'background #xfafafa) 39 | (widget-set-attrs s1 'background #xffffff) 40 | (widget-set-attrs s0 'show-scroll #f) 41 | ;;(widget-set-attrs editor 'font "Roboto-Regular.ttf") 42 | 43 | ;;(widget-set-child-attrs file-tree 'color #xff000000) 44 | (widget-set-child-attrs header 'color #xffffffff) 45 | (widget-set-child-attrs header 'background #xaa333333) 46 | (widget-set-attrs header 'background #x33333333) 47 | (widget-set-child-attrs header 'hover-background #x33333333) 48 | 49 | (widget-set-attrs editor 'font-size 22.0) 50 | (widget-set-attrs editor 'font-line-height 1.2) 51 | ))) -------------------------------------------------------------------------------- /extensions/keys/edit.key.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;Copyright 2016-2080 evilbinary. 3 | ;作者:evilbinary on 12/24/16. 4 | ;邮箱:rootdebug@163.com 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | (import (extensions extension)) 7 | (import duck.keys) 8 | 9 | (register 'keys.edit (lambda (duck) 10 | (init-key-map) 11 | (let ((editor (get-var duck 'editor)) 12 | (s0 (get-var duck 'tree.scroll )) 13 | (s1 (get-var duck 'editor.scroll )) 14 | (syn (get-var duck 'syntax ))) 15 | (set-key-map '(ctl a) (lambda() 16 | (printf "hook key ctl a\n") 17 | (printf "line count===>~a\n" (widget-get-attrs editor 'line-count )) 18 | (printf "last-row-count=>~a\n" (widget-get-attrs editor 'last-row-count) ) 19 | (widget-set-attrs editor 'selection 20 | (list 0 0 21 | (widget-get-attrs editor 'line-count ) 22 | (widget-get-attrs editor 'last-row-count))) 23 | )) 24 | (set-key-map '(ctl c) (lambda() 25 | (printf "hook key ctl c\n") 26 | ;;(printf "get copy ~a\n" (widget-get-attrs editor 'selection) ) 27 | (set-var 'editor.copy (widget-get-attrs editor 'selection)) 28 | ;(printf "current line text ~a\n" (widget-get-attrs editor 'current-line-text)) 29 | )) 30 | (set-key-map '(cmd c) (lambda() 31 | (set-var 'editor.copy (widget-get-attrs editor 'selection)) 32 | )) 33 | (set-key-map '(cmd a) (lambda() 34 | (widget-set-attrs editor 'selection 35 | (list 0 0 36 | (widget-get-attrs editor 'line-count ) 37 | (widget-get-attrs editor 'last-row-count))) 38 | )) 39 | 40 | (set-key-map '(cmd v) (lambda() 41 | (printf "insert-text-at\n") 42 | (widget-set-attrs editor 'insert-text-at (list 0 0 "hahah")) 43 | )) 44 | 45 | (widget-add-event editor (lambda (w p type data) 46 | (if (= type %event-key) 47 | (let ((action (vector-ref data 2)) 48 | (key (vector-ref data 0)) 49 | (scancode (vector-ref data 1)) 50 | (mods (vector-ref data 3))) 51 | (printf "get editor event ~a action=~a key=~a mods=~a\n" type action key mods ) 52 | (set-key-status key action) 53 | (process-keys-map) 54 | )) 55 | )) 56 | ))) -------------------------------------------------------------------------------- /extensions/extension.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;作者:evilbinary on 11/19/17. 3 | ;;邮箱:rootdebug@163.com 4 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 5 | (library (extensions extension) 6 | (export 7 | get-var 8 | set-var 9 | register 10 | unregister 11 | get-extension 12 | load-extension 13 | load-extensions 14 | duck-extensions 15 | duck-global 16 | path-append 17 | register-var-change 18 | ) 19 | 20 | (import (scheme) (utils libutil) (cffi cffi) (utils macro) ) 21 | 22 | (define-syntax path-append 23 | (syntax-rules () 24 | ((_ p a ...) 25 | (string-append p (string (directory-separator)) a ...)))) 26 | 27 | (define duck-extensions (make-hashtable equal-hash equal?)) 28 | (define duck-global (make-hashtable equal-hash equal?) ) 29 | 30 | (define (register name proc) 31 | (if (hashtable-contains? duck-extensions name) 32 | (printf "extension ~a allready exists!\n" name)) 33 | (hashtable-set! duck-extensions name proc) 34 | ) 35 | 36 | (define (unregister name) 37 | (hashtable-delete! duck-extensions name )) 38 | 39 | (define (get-extension name) 40 | (hashtable-ref duck-extensions name '())) 41 | 42 | (define (load-extension file) 43 | (printf "loading... ~a\n" (path-append (get-var 'extensions.dir) file) ) 44 | (load (path-append (get-var 'extensions.dir) file)) 45 | ) 46 | 47 | (define (load-extensions x) 48 | (let-values ([(keyvec valvec) (hashtable-entries x)]) 49 | (vector-for-each 50 | (lambda (key val) 51 | (printf "load extensions >~s ~s \n" key val) 52 | (if (procedure? val) 53 | (val duck-global) 54 | )) 55 | keyvec valvec))) 56 | 57 | (define get-var 58 | (case-lambda 59 | [(duck name) 60 | (hashtable-ref duck name '() )] 61 | [(name) 62 | (hashtable-ref duck-global name '() )] 63 | ) 64 | ) 65 | 66 | (define set-var 67 | (case-lambda 68 | [(duck name val) 69 | (hashtable-set! duck name val) 70 | (event-on-change name val) 71 | ] 72 | [(name val) 73 | (hashtable-set! duck-global name val ) 74 | (event-on-change name val) 75 | ] 76 | )) 77 | 78 | (define (register-var-change name fun) 79 | (let ((events (get-var (format "%event-~a-hook" name) )) 80 | (event-name (format "%event-~a-hook" name) ) 81 | ) 82 | (if (null? events) 83 | (set-var event-name (list fun)) 84 | (set-var event-name (append events (list fun) ) ))) 85 | ;;(printf "reg events ~a ~a\n" name (get-var (format "%event-~a-hook" name) ) ) 86 | ) 87 | 88 | (define (event-on-change name val) 89 | (let loop ((events (get-var (format "%event-~a-hook" name) ))) 90 | (if (pair? events) 91 | (begin 92 | (if (procedure? (car events)) 93 | ((car events) name val) 94 | ) 95 | (loop (cdr events)) 96 | ) 97 | ) 98 | )) 99 | ) -------------------------------------------------------------------------------- /app.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;Copyright 2016-2080 evilbinary. 3 | ;作者:evilbinary on 12/24/16. 4 | ;邮箱:rootdebug@163.com 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | (import (scheme) 7 | (glfw glfw) 8 | (gui graphic) 9 | (gui duck) 10 | (gui draw) 11 | (gui stb) 12 | (gles gles1) 13 | (gui window) 14 | (cffi cffi) 15 | (gui layout) 16 | (gui widget) 17 | (gui syntax) 18 | (c c-ffi) 19 | (extensions extension) 20 | (utils libutil) (utils macro) (utils trace)) 21 | 22 | (define window '() ) 23 | (define width 1000) 24 | (define height 850) 25 | ;;(cffi-log #t) 26 | (stack-trace-exception) 27 | 28 | (define app-dir "../apps/duck-editor") 29 | 30 | (define (init-res) 31 | (set-var 'app.dir app-dir) 32 | (set-var 'resources.dir (path-append app-dir "resources") ) 33 | (set-var 'extensions.dir (path-append app-dir "extensions") ) 34 | ) 35 | 36 | (define (init-editor) 37 | (let ((header (pop %match-parent 30.0 "")) 38 | (panel (view %match-parent %match-parent)) 39 | (s0 (scroll 200.0 %match-parent )) 40 | (s1 (scroll %fill-rest %match-parent )) 41 | (file-tree '() ) 42 | (editor (edit %match-parent %wrap-content "" ) ) 43 | (syn (init-syntax)) 44 | ) 45 | ;;reg var 46 | (set-var 'editor editor) 47 | (set-var 'syntax syn) 48 | (set-var 'tree file-tree) 49 | (set-var 'menu header) 50 | (set-var 'theme '() ) 51 | (set-var 'editor.scroll s1 ) 52 | (set-var 'tree.scroll s0 ) 53 | 54 | (widget-set-padding panel 0.0 0.0 30.0 30.0) 55 | 56 | ;;(make-file-tree file-tree "../") 57 | ;;(make-file-tree file-tree "/Users/evil/dev/lisp/scheme-lib/") 58 | 59 | (widget-set-attrs s0 'background #x272822) 60 | (widget-set-attrs s1 'background #x272822) 61 | 62 | (if (not (null? file-tree)) 63 | (begin 64 | (widget-add s0 file-tree) 65 | (widget-set-padding file-tree 40.0 20.0 20.0 20.0) 66 | )) 67 | 68 | (widget-set-attr s0 %text "tree scroll") 69 | (widget-set-attr s1 %text "edit scroll") 70 | (widget-set-attr panel %text "panel") 71 | 72 | (widget-add s1 editor) 73 | 74 | ;;(widget-set-layout s1 frame-layout) 75 | (widget-add panel s0) 76 | (widget-add panel s1) 77 | (widget-add panel) 78 | (widget-add header) 79 | 80 | ) 81 | ) 82 | 83 | (define (init-event) 84 | (register-var-change 85 | 'editor.copy 86 | (lambda (name val) 87 | (printf "val ~a change ~a\n" name val) 88 | (glfw-set-clipboard-string window val) 89 | )) 90 | ) 91 | 92 | (define (load-conf) 93 | (if (file-exists? (path-append app-dir ".duck.ss")) 94 | (load (path-append app-dir ".duck.ss"))) 95 | (if (file-exists? "~/.duck.ss") 96 | (load "~/.duck.ss")) 97 | (if (file-exists? "~/.duck") 98 | (load "~/.duck")) 99 | ) 100 | 101 | (define (process-args) 102 | (if (> (length (command-line)) 0) 103 | (if (file-directory? (list-ref (command-line) 0 )) 104 | (set! app-dir (list-ref (command-line) 0 ) ) 105 | (set! app-dir (path-parent (list-ref (command-line) 0 )) ) 106 | )) 107 | (printf "app.dir ~a\n" app-dir) 108 | (set-var 'work.dir app-dir) 109 | ) 110 | 111 | (define (duck-editor) 112 | (set! window (window-create width height "鸭子编辑器")) 113 | ;;(window-set-fps-pos 750.0 0.0) 114 | ;;(window-set-fps-pos 0.0 0.0) 115 | ;;(window-set-wait-mode #f) 116 | (window-show-fps #t) 117 | (process-args) 118 | ;;load res 119 | (init-res) 120 | ;;ui init here 121 | (init-editor) 122 | ;;init event 123 | (init-event) 124 | ;;load config 125 | (load-conf) 126 | ;;load extensitons 127 | (load-extensions duck-extensions) 128 | ;;run 129 | (window-loop window) 130 | (window-destroy window) 131 | ) 132 | 133 | (duck-editor) 134 | -------------------------------------------------------------------------------- /extensions/menu/bar.menu.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;Copyright 2016-2080 evilbinary. 3 | ;作者:evilbinary on 12/24/16. 4 | ;邮箱:rootdebug@163.com 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | (import (extensions extension)) 7 | (import duck.browser duck.tree duck.file duck.menu) 8 | 9 | (register 'menu.bar (lambda (duck) 10 | (let ((editor (get-var duck 'editor)) 11 | (file-tree (get-var duck 'tree )) 12 | (header (get-var duck 'menu )) 13 | (s0 (get-var duck 'tree.scroll )) 14 | (work-dir (get-var duck 'work.dir )) 15 | (about (dialog 240.0 180.0 320.0 200.0 "关于鸭子编辑器")) 16 | ) 17 | 18 | ;;set header 19 | (let ((menu-file (pop 60.0 30.0 "文件")) 20 | (menu-edit (pop 60.0 30.0 "编辑")) 21 | (menu-setting (pop 60.0 30.0 "设置")) 22 | (menu-help (pop 60.0 30.0 "帮助")) 23 | (menu-search (pop 60.0 30.0 "查找")) 24 | (menu-tool (pop 60.0 30.0 "工具")) 25 | 26 | 27 | (menu-open (icon-pop 120.0 30.0 "打开" "open.png" "C-o")) 28 | (menu-save (icon-pop 120.0 30.0 "保存" "save.png" "C-s")) 29 | (menu-quit (icon-pop 120.0 30.0 "退出" "exit.png" "C-q")) 30 | (menu-about (icon-pop 120.0 30.0 "关于" "about.png" "")) 31 | (menu-manual (icon-pop 120.0 30.0 "文档" "manual.png" "")) 32 | ;;(file-list (file-browser work-dir) ) 33 | ) 34 | (widget-set-events 35 | menu-quit 'click 36 | (lambda (w p type data) 37 | (exit) 38 | )) 39 | 40 | (widget-set-events 41 | menu-save 'click 42 | (lambda (w p type data) 43 | (printf "save file ~a ~a\n" (get-var 'editor.file) (string-length (widget-get-attr editor %text ))) 44 | (save-file (get-var 'editor.file) (widget-get-attr editor %text )) 45 | )) 46 | 47 | (widget-add header menu-file) 48 | (widget-add header menu-edit) 49 | (widget-add header menu-search) 50 | ;;(widget-add header menu-setting) 51 | (widget-add header menu-tool) 52 | (widget-add header menu-help) 53 | ;;(widget-add header menu-empty) 54 | ;;(widget-add file-list ) 55 | 56 | 57 | (widget-set-attrs header 'center #t) 58 | (widget-set-attrs header 'root #t) 59 | (widget-set-attrs header 'static #t) 60 | 61 | (widget-set-attrs menu-file 'root #t) 62 | (widget-set-attrs menu-edit 'root #t) 63 | (widget-set-attrs menu-search 'root #t) 64 | (widget-set-attrs menu-help 'root #t) 65 | (widget-set-attrs menu-tool 'root #t) 66 | ;;(widget-set-attrs menu-setting 'root #t) 67 | 68 | 69 | ;;(widget-set-attrs menu-empty 'is-root #t) 70 | 71 | (widget-add menu-file menu-open) 72 | (widget-add menu-file menu-save) 73 | ;;preference setting 74 | (let ((preference (icon-pop 120.0 30.0 "偏好" "perffernce.png" "C-p"))) 75 | (widget-add menu-file preference) 76 | ) 77 | 78 | ;;edit 79 | (let ((undo (icon-pop 120.0 30.0 "撤销" "undo.png" "C-z")) 80 | (redo (icon-pop 120.0 30.0 "重做" "redo.png" "C-S-z")) 81 | (copy (icon-pop 120.0 30.0 "拷贝" "copy.png" "C-c")) 82 | (paste (icon-pop 120.0 30.0 "粘贴" "paste.png" "C-v")) 83 | ) 84 | (widget-add menu-edit undo) 85 | (widget-add menu-edit redo) 86 | (widget-add menu-edit copy) 87 | (widget-add menu-edit paste) 88 | ) 89 | 90 | ;;search 91 | (let ((find (icon-pop 120.0 30.0 "查找" "find.png" "C-f")) 92 | (replace (icon-pop 120.0 30.0 "替换" "replace.png" "C-r")) 93 | ) 94 | (widget-add menu-search find) 95 | (widget-add menu-search replace) 96 | ) 97 | ;;tools 98 | (let ((cmd (icon-pop 120.0 30.0 "命令行" "shell.png" "")) 99 | (chat (icon-pop 120.0 30.0 "聊天" "chat.png" "")) 100 | ) 101 | (widget-add menu-tool cmd) 102 | (widget-add menu-tool chat) 103 | ) 104 | 105 | 106 | 107 | (widget-add menu-file menu-quit) 108 | (widget-add menu-help menu-manual) 109 | (widget-add menu-help menu-about) 110 | 111 | 112 | ;;set abount 113 | (let ((info (edit %match-parent 120.0 "鸭子编辑器v1.0,群：Lisp兴趣小组239401374")) 114 | (close (button 120.0 30.0 "关闭")) 115 | ) 116 | (widget-add about info) 117 | (widget-add about close) 118 | (widget-add about) 119 | (widget-set-attr about %visible #f) 120 | 121 | ;;(widget-set-margin close 0.0 0.0 100.0 100.0) 122 | (widget-set-attrs info 'editable #f) 123 | (widget-set-events 124 | close 'click 125 | (lambda (w p type data) 126 | (widget-set-attr about %visible #f))) 127 | (widget-set-events 128 | menu-about 'click 129 | (lambda (w p type data) 130 | (widget-set-attr about %visible #t))) 131 | 132 | (widget-set-events 133 | menu-open 'click 134 | (lambda (w p type data) 135 | (if (null? (get-var 'file-browser)) 136 | (let ((fb (file-browser work-dir))) 137 | (set-var 'file-browser fb) 138 | (widget-add fb)) 139 | (begin 140 | (widget-set-attr (get-var 'file-browser) %visible #t) 141 | ;;(widget-layout-update (widget-get-root (get-var 'file-browser))) 142 | )) 143 | )) 144 | ) 145 | 146 | )))) 147 | -------------------------------------------------------------------------------- /extensions/scheme/scheme.complete.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;Copyright 2016-2080 evilbinary. 3 | ;作者:evilbinary on 12/24/16. 4 | ;邮箱:rootdebug@163.com 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | (import (extensions extension)) 7 | 8 | (module scheme.complete (id-completions show-complete find-previous-word) 9 | (import duck.snippets) 10 | (define-syntax assert* 11 | (syntax-rules () 12 | [(_ expr ...) 13 | (begin (assert expr) ...)])) 14 | 15 | (define-syntax on-error 16 | (syntax-rules () 17 | [(on-error e0 e1 e2 ...) 18 | (guard (c [#t e0]) e1 e2 ...)])) 19 | 20 | (define common-identifiers 21 | (make-parameter 22 | '(append apply call/cc call-with-values define display display-string 23 | define-syntax define-record null? quote quotient reverse read-char 24 | substring string-ref string-length string? string=? string-set! 25 | syntax-case syntax-rules unless vector-ref vector-length vector? 26 | vector-set! vector) 27 | (lambda (x) 28 | (unless (and (list? x) (andmap symbol? x)) 29 | ($oops 'common-identifiers "~s is not a list of symbols" x)) 30 | x))) 31 | (define entry-col string-length) 32 | (define (id-completions entry) 33 | (define (idstringsymbol (string-append prefix s1))] 38 | [x2 (string->symbol (string-append prefix s2))]) 39 | ; prefer common 40 | (let ([m1 (memq x1 common)] [m2 (memq x2 common)]) 41 | (if m1 42 | (or (not m2) (< (length m2) (length m1))) 43 | (and (not m2) 44 | ; prefer user-defined 45 | (let ([u1 (not (memq x1 scheme-syms))] 46 | [u2 (not (memq x2 scheme-syms))]) 47 | (if u1 48 | (or (not u2) (string= n2 n1) 53 | (string=? (substring str2 0 n1) str1) 54 | (substring str2 n1 n2)))) 55 | (define (fn-completions prefix) 56 | (values prefix 57 | (sort string 63 | (lambda (suffix) 64 | (cons (if (file-directory? (string-append prefix suffix)) 65 | (string-append suffix (string (directory-separator))) 66 | suffix) 67 | suffix*))] 68 | [else suffix*]))) 69 | '() 70 | (on-error '() 71 | (directory-list 72 | (let ([dir (path-parent prefix)]) 73 | (if (string=? dir "") "." dir)))))))) 74 | (let loop ([c 0]) 75 | (if (fx>= c (entry-col entry)) 76 | (values #f '()) 77 | (let ([s (let ([s entry]) 78 | (substring s c (string-length s)))]) 79 | ((on-error 80 | (lambda () 81 | (if (and (fx> (string-length s) 0) (char=? (string-ref s 0) #\")) 82 | (fn-completions (substring s 1 (string-length s))) 83 | (loop (fx+ c 1)))) 84 | (let-values ([(type value start end) (read-token (open-input-string s))]) 85 | (lambda () 86 | (cond 87 | [(and (fx= (fx+ c end) (entry-col entry)) 88 | (eq? type 'atomic) 89 | (symbol? value)) 90 | (let ([prefix (symbol->string value)]) 91 | (values prefix 92 | (sort (idstringstring x)) => 96 | (lambda (suffix) (cons suffix suffix*))] 97 | [else suffix*])) 98 | '() (environment-symbols (interaction-environment))))))] 99 | [(and (fx= (fx+ c end -1) (entry-col entry)) 100 | (eq? type 'atomic) 101 | (string? value)) 102 | (fn-completions value)] 103 | [else (loop (fx+ c end))]))))))))) 104 | 105 | 106 | (define (show-complete keyword) 107 | (let-values ([(prefix suffix*) (id-completions keyword)]) 108 | (if prefix 109 | (begin 110 | ; (printf "prefix ~a ~a == ~a\n" prefix (length suffix*) 111 | ; (length (map (lambda (suffix) (string-append prefix suffix)) suffix*) )) 112 | (show-snippets (map (lambda (suffix) (string-append prefix suffix)) suffix*) ) 113 | )))) 114 | 115 | (define separator? 116 | (lambda (c) 117 | (memq c '(#\space #\; #\( #\) #\[ #\] #\" #\' #\`)))) 118 | 119 | 120 | (define find-previous-word 121 | (case-lambda 122 | [(entry cols) 123 | (let ([lns entry]) 124 | (let loop ([col cols]) 125 | (cond 126 | [(or (fx= col 0) 127 | (separator? (string-ref entry (fx1- col)))) 128 | (begin 129 | ;;(printf "==>~a\n" (substring entry col cols)) 130 | (substring entry col cols))] 131 | [else (loop (fx1- col))]))) 132 | ] 133 | [(entry) 134 | (find-previous-word entry (string-length entry)) 135 | ] 136 | )) 137 | 138 | 139 | 140 | ) -------------------------------------------------------------------------------- /extensions/duck/editor.duck.ss: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;Copyright 2016-2080 evilbinary. 3 | ;;作者:evilbinary on 12/24/16. 4 | ;;邮箱:rootdebug@163.com 5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 6 | (import (extensions extension)) 7 | 8 | (module duck.keys (init-key-map 9 | get-default-key-map 10 | set-key-map set-key-status 11 | is-key-press process-keys-map) 12 | 13 | (define all-key-func (make-hashtable equal-hash equal?)) 14 | (define all-keys-status (make-hashtable equal-hash equal?) ) 15 | (define default-key-map (make-hashtable equal-hash equal?)) 16 | (define default-key-maps 17 | (list 18 | '(ctl 341) 19 | '(shift 340) 20 | '(alt 342) 21 | '(tab 258) 22 | '(caps-lock #x0010) 23 | '(num-lock #x0020) 24 | '(a 65) 25 | '(b 66) 26 | '(c 67) 27 | '(d 68) 28 | '(v 86) 29 | '(x 88) 30 | '(enter 257) 31 | '(backspace 259) 32 | '(/ 47) 33 | '(cmd 343) 34 | '(esc 256) 35 | )) 36 | 37 | (define (set-default-key-map key val) 38 | (hashtable-set! default-key-map key val)) 39 | 40 | (define (get-default-key-map key) 41 | (hashtable-ref default-key-map key '())) 42 | 43 | (define (init-key-map) 44 | (let loop ((l default-key-maps)) 45 | (if (pair? l) 46 | (begin 47 | ;;(printf "~a ~a ~a\n" (car l) (caar l) (cadar l)) 48 | (set-default-key-map (caar l) (cadar l)) 49 | (set-default-key-map (cadar l) (caar l)) 50 | (loop (cdr l)) 51 | )))) 52 | 53 | (define (set-key-status key action) 54 | (hashtable-set! all-keys-status key action) 55 | ) 56 | (define (is-key-press key) 57 | (hashtable-ref all-keys-status (get-default-key-map key) '())) 58 | 59 | (define (is-multi-key-press keys) 60 | (= (length keys) 61 | (length (filter (lambda (x ) 62 | (let ((ret (is-key-press x) )) 63 | (if (null? ret) 64 | #f 65 | (begin 66 | ;;(printf ">0 ~a\n" (> ret 0)) 67 | (> ret 0)) 68 | ))) 69 | keys)))) 70 | 71 | (define (set-key-map keys fun) 72 | (hashtable-set! all-key-func keys fun)) 73 | 74 | (define (get-key-map keys) 75 | (hashtable-ref all-key-func keys '())) 76 | 77 | 78 | (define (process-key-map keys) 79 | (if (is-multi-key-press keys ) 80 | (let ((fun (get-key-map keys ))) 81 | (fun)) 82 | )) 83 | 84 | (define (process-keys-map) 85 | (let loop ((k (vector->list (hashtable-keys all-key-func)))) 86 | (if (pair? k) 87 | (begin 88 | (process-key-map (car k)) 89 | (loop (cdr k)) 90 | ) 91 | ) 92 | )) 93 | ) 94 | 95 | (module duck.snippets (pop-snippets show-snippets set-snippets-pos show-snippets-pos hide-snippets) 96 | (import duck.keys) 97 | (define (pop-snippets) 98 | (let ( (p (view 380.0 430.0 ) ) 99 | ) 100 | (let loop ((child (widget-get-child p))) 101 | (if (pair? child) 102 | (begin 103 | (widget-set-attrs (car child) 'text-align 'left) 104 | (widget-set-attrs (car child) 'padding-left 18.0) 105 | (loop (cdr child)) 106 | ))) 107 | 108 | (widget-set-attrs p 'background #x010000ff) 109 | (widget-add-event p 110 | (lambda (widget parent type d) 111 | (if (= type %event-key) 112 | (if (equal? 'enter (get-default-key-map (vector-ref d 0))) 113 | (begin 114 | (printf "enter\n") 115 | (hide-snippets) 116 | (printf "focus-child ~a\n" (widget-get-attrs (get-var 'editor.snippets) 'focus-child ) ) 117 | (if (not (null? (widget-get-attrs (get-var 'editor.snippets) 'focus-child ))) 118 | (set-var 'editor.snippets.text 119 | (widget-get-attr (widget-get-attrs (get-var 'editor.snippets) 'focus-child ) %text))) 120 | ;;(printf "visible=>~a\n" (widget-get-attr (get-var 'editor) %visible )) 121 | ;;(widget-layout-update (widget-get-root p)) 122 | ) 123 | ) 124 | ;;(printf "key ~a\n" (get-default-key-map (vector-ref d 0))) 125 | )) 126 | ) 127 | p 128 | ) 129 | ) 130 | 131 | (define (show-snippets-pos lx ly ) 132 | (let ((snippets (get-var 'editor.snippets))) 133 | (widget-set-xy snippets lx ly) 134 | (widget-set-status snippets %status-active) 135 | (widget-clear-status (get-var 'editor) %status-active) 136 | (widget-set-attr snippets %visible #t) 137 | ;;(widget-layout-update (widget-get-root snippets)) 138 | )) 139 | (define (hide-snippets ) 140 | (let ((snippets (get-var 'editor.snippets))) 141 | (widget-clear-status snippets %status-active) 142 | (widget-set-attr snippets %visible #f) 143 | (widget-set-status (get-var 'editor) %status-active) 144 | ) 145 | ) 146 | 147 | (define (show-snippets . lst) 148 | (let ((snippets (get-var 'editor.snippets))) 149 | (widget-set-status snippets %status-active) 150 | (widget-clear-status (get-var 'editor) %status-active) 151 | (widget-set-attr snippets %visible #t) 152 | (if (> (length lst) 0) 153 | (set-snippets-child snippets (list-ref lst 0))) 154 | ) 155 | ) 156 | 157 | (define (set-snippets-child snippets lst) 158 | (widget-set-child snippets '()) 159 | (let loop ((c lst)) 160 | (if (pair? c) 161 | (begin 162 | ;(printf "=>~a\n" (car c)) 163 | (widget-add snippets (button 380.0 30.0 (car c) ) ) 164 | (loop (cdr c)) 165 | ))) 166 | (let loop ((child (widget-get-child snippets))) 167 | (if (pair? child) 168 | (begin 169 | (widget-set-attrs (car child) 'text-align 'left) 170 | (widget-set-attrs (car child) 'padding-left 18.0) 171 | (loop (cdr child)) 172 | ))) 173 | (widget-layout-update snippets) 174 | ) 175 | 176 | (define (set-snippets-pos lx ly ) 177 | (let ((snippets (get-var 'editor.snippets))) 178 | (widget-set-xy snippets lx ly) 179 | ;;(widget-layout-update (widget-get-root snippets)) 180 | ) 181 | ) 182 | ) 183 | 184 | (module duck.file (readlines read-line readlines2 save-file) 185 | (define (read-line . port) 186 | (let* ((char (apply read-char port))) 187 | (if (eof-object? char) 188 | char 189 | (do ((char char (apply read-char port)) 190 | (clist '() (cons char clist))) 191 | ((or (eof-object? char) (char=? #\newline char)) 192 | (list->string (reverse clist))))))) 193 | 194 | (define (readlines2 filename) 195 | (call-with-input-file filename 196 | (lambda (p) 197 | (let loop ((line (read-line p)) 198 | (result "" )) 199 | (if (eof-object? line) 200 | (string-append result "\n") 201 | (loop (read-line p) 202 | (string-append result line "\n"))))))) 203 | 204 | (define (readlines file) 205 | (let ((f (c-fopen file "rb")) 206 | (buf (cffi-alloc 1028)) 207 | (buffer "") 208 | ) 209 | (let loop ((len (c-fread buf 1 1024 f))) 210 | (if (> len 0) 211 | (begin 212 | '() 213 | ;;(cwrite-all port buf len) 214 | ;;(printf "buff ~a\n" (cffi-string buf)) 215 | (set! buffer (string-append buffer (cffi-string buf))) 216 | (cffi-set buf 0 1024) 217 | (loop (c-fread buf 1 1024 f)) ) 218 | (begin 219 | (c-fclose f ) 220 | buffer) 221 | ) ))) 222 | (define (save-file filename content) 223 | (let ((p (open-output-file filename 'replace))) 224 | (display content p) 225 | (close-output-port p))) 226 | ) 227 | 228 | (module duck.image (image-dialog image-view) 229 | (define (image-view w h src) 230 | (let ((img (image w h src)) 231 | (file-name src)) 232 | ;;(widget-set-attrs img 'mode 'center-crop) 233 | (if (file-exists? file-name) 234 | (begin 235 | (widget-set-attrs img 'src file-name) 236 | (widget-set-attrs img 'load #f)) 237 | ;;(window-post-empty-event) 238 | ) 239 | img 240 | )) 241 | 242 | (define (image-dialog w h src) 243 | (let ((d (dialog 240.0 180.0 (+ w 80.0) (+ h 120.0) src)) 244 | (close (button 120.0 30.0 "关闭")) 245 | (img (image-view w h src)) ) 246 | ;;(widget-set-margin close 60.0 40.0 40.0 40.0) 247 | ;;(widget-set-margin img 60.0 40.0 40.0 40.0) 248 | (widget-add d img) 249 | (widget-add d close) 250 | (widget-set-events 251 | close 'click 252 | (lambda (w p type data) 253 | (widget-set-attr d %visible #f) 254 | )) 255 | d 256 | ) 257 | ) 258 | 259 | ) 260 | (module duck.menu (icon-pop ) 261 | (import (gui stb)) 262 | 263 | (define (icon-pop w h text src shot-key) 264 | (let ((it (pop w h text)) 265 | (icon '())) 266 | (if (not (null? src)) 267 | (set! icon (load-texture (path-append (get-var 'resources.dir) src) ))) 268 | (widget-set-attrs it 'icon icon) 269 | (widget-set-attrs it 'shot-key shot-key) 270 | (widget-set-attrs it 'text-align 'left) 271 | (widget-set-attrs it 'padding-left 40.0) 272 | (widget-add-draw 273 | it 274 | (lambda (w p) 275 | (let ((x (vector-ref w %gx)) 276 | (y (vector-ref w %gy))) 277 | (if (null? (widget-get-attrs w 'icon)) 278 | '() 279 | (begin 280 | (if (string? shot-key) 281 | (draw-text (+ x 80.0) (+ y 2.0) shot-key)) 282 | (draw-image (+ 10.0 x) (+ y 6.0) 18.0 18.0 (widget-get-attrs w 'icon))))) 283 | )) 284 | it 285 | )) 286 | 287 | ) 288 | 289 | (module duck.tree (icon-tree make-file-tree reload-file-tree init-tree-res) 290 | (import duck.file duck.image) 291 | (define (icon-tree w h text) 292 | (let ((it (tree w h text))) 293 | (widget-add-draw 294 | it 295 | (lambda (w p) 296 | (let ((x (vector-ref w %gx)) 297 | (y (vector-ref w %gy))) 298 | (if (null? (widget-get-attrs w 'dir)) 299 | (draw-image (+ -20.0 x) (+ y 6.0) 15.0 15.0 file-icon) 300 | (draw-image (+ -20.0 x) (+ y 6.0) 15.0 15.0 dir-icon)) 301 | ) 302 | )) 303 | (widget-set-padding it 15.0 20.0 20.0 20.0) 304 | it 305 | )) 306 | (define tree-item-click 307 | (lambda (w p type data) 308 | (printf "click ~a ~a\n" type 309 | (widget-get-attr w %text) 310 | ) 311 | (let ((path (widget-get-attrs w 'path))) 312 | (if (file-directory? (path-append path (widget-get-attr w %text))) 313 | (begin 314 | (widget-set-attrs w 'dir #t) 315 | (widget-set-child w '()) 316 | (make-file-tree w (path-append path (widget-get-attr w %text) "/") ) 317 | (widget-layout-update (widget-get-root w)) 318 | ) 319 | (let ((file (path-append path (widget-get-attr w %text))) 320 | (ext (path-extension (widget-get-attr w %text)))) 321 | ;;(printf "ed select ~a\n" (string-append path (widget-get-attr w %text)) ) 322 | (if (member ext '("jpg" "png" "jpeg")) 323 | (let ((d (image-dialog 400.0 400.0 file) )) 324 | (widget-add d) 325 | (widget-layout-update d) 326 | ) 327 | (begin 328 | (set-var 'editor.file file) 329 | (printf "open select ~a\n" file) 330 | (widget-set-attr (get-var 'editor) %text (readlines file) ) 331 | )) 332 | ) 333 | ) 334 | ))) 335 | 336 | (define (make-file-tree tree path) 337 | (let loop ((files (directory-list path))) 338 | (if (pair? files) 339 | (let ((n (icon-tree 200.0 200.0 (car files) ))) 340 | (if (file-directory? (path-append path (car files))) 341 | (widget-set-attrs n 'dir #t)) 342 | (widget-set-attrs n 'path path) 343 | (widget-set-events 344 | n 345 | 'click 346 | tree-item-click 347 | ) 348 | (widget-set-attrs n 'color (widget-get-attrs tree 'color )) 349 | (widget-add tree n) 350 | (loop (cdr files))) 351 | )) 352 | ) 353 | 354 | (define (reload-file-tree t file) 355 | (widget-set-child t '()) 356 | (make-file-tree t file) 357 | (widget-layout-update (widget-get-root t)) 358 | (printf "(path-last file)=~a\n" (path-last file) ) 359 | (widget-set-attr t %text (string-append " " (path-last file) )) 360 | (printf "(widget-get-attr w %text)=>~a\n" (widget-get-attr t %text) ) 361 | ) 362 | (define file-icon -1) 363 | (define dir-icon -1) 364 | (define dir-icon-open -1) 365 | 366 | (define (init-tree-res) 367 | (let ((resources-dir (get-var 'resources.dir))) 368 | (set! file-icon (load-texture (path-append resources-dir "file-text.png"))) 369 | (set! dir-icon (load-texture (path-append resources-dir "folder.png"))) 370 | (set! dir-icon-open (load-texture (path-append resources-dir "folder-open.png"))) 371 | )) 372 | ) 373 | 374 | (module duck.browser (file-browser) 375 | (import duck.file duck.tree) 376 | (define (file-browser path) 377 | (let ((d (dialog 240.0 180.0 680.0 400.0 "文件管理")) 378 | (input (edit 400.0 40.0 path)) 379 | (open (button 80.0 40.0 "打开")) 380 | (close (button 80.0 40.0 "取消")) 381 | (list-scroll (scroll 620.0 280.0 )) 382 | (t (tree %match-parent %match-parent "上级")) 383 | ) 384 | (define (string-trim str t) 385 | (list->string (remove! t (string->list str))) 386 | ) 387 | 388 | (define (make-file-list tree path) 389 | (let loop ((files (directory-list path))) 390 | (if (pair? files) 391 | (let ((n (icon-tree 200.0 200.0 (car files) ))) 392 | (if (file-directory? (path-append path (car files))) 393 | (widget-set-attrs n 'dir #t)) 394 | (widget-set-attrs n 'path path) 395 | (widget-set-events 396 | n 397 | 'click 398 | (lambda (w p type data) 399 | (printf "select ~a\n" (path-append path (car files)) ) 400 | (if (file-directory? (path-append path (car files)) ) 401 | (begin 402 | (reload-file-list (path-append path (car files)) ) 403 | )) 404 | (widget-set-attr input %text (path-append path (car files))) 405 | ) 406 | ) 407 | (widget-add tree n) 408 | (loop (cdr files))) 409 | )) 410 | ) 411 | (define (reload-file-list file) 412 | (widget-set-child t '()) 413 | (make-file-list t file) 414 | (printf "file=~a\n" file) 415 | (widget-layout-update (widget-get-root t)) 416 | ) 417 | 418 | ;;(widget-set-padding input 10.0 10.0 0.0 0.0) 419 | (widget-set-margin input 10.0 10.0 0.0 0.0) 420 | (widget-set-margin open 10.0 10.0 0.0 0.0) 421 | (widget-set-margin list-scroll 10.0 10.0 10.0 0.0) 422 | (widget-add d input) 423 | (widget-add d open) 424 | (widget-add d close) 425 | (widget-add d list-scroll) 426 | (widget-add list-scroll t) 427 | (widget-set-attrs input 'border #xff6273a1) 428 | (widget-set-attrs input 'background #xff20232c) 429 | (widget-set-attrs list-scroll 'background #xff20232c) 430 | (make-file-list t path) 431 | (widget-set-attrs t 'expanded #t) 432 | 433 | (widget-set-events 434 | close 'click 435 | (lambda (w p type data) 436 | (widget-set-attr d %visible #f) 437 | )) 438 | (widget-set-events 439 | t 'click 440 | (lambda (w p type data) 441 | (let ((path (path-parent (widget-get-attr input %text)))) 442 | (printf "go upper\n") 443 | (widget-set-attr input %text path) 444 | (reload-file-list path)) 445 | )) 446 | (widget-set-events 447 | open 'click 448 | (lambda (w p type data) 449 | (let ((file (string-trim (widget-get-attr input %text) #\newline))) 450 | (if (file-directory? file) 451 | (begin 452 | ;;(reload-file-list file) 453 | (set-var 'work.dir file) 454 | (widget-set-attr d %visible #f) 455 | ) 456 | (if (file-exists? file ) 457 | (begin 458 | (set-var 'editor.file file) 459 | (widget-set-attr (get-var 'editor) %text (readlines2 file ) ) 460 | (widget-set-attr d %visible #f)) 461 | (printf "file not exist ~a\n" file)) 462 | )) 463 | )) 464 | 465 | ;;(widget-add d) 466 | ;;(widget-layout-update (widget-get-root d)) 467 | d 468 | )) 469 | ) -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | GNU GENERAL PUBLIC LICENSE 2 | Version 2, June 1991 3 | 4 | Copyright (C) 1989, 1991 Free Software Foundation, Inc., 5 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 6 | Everyone is permitted to copy and distribute verbatim copies 7 | of this license document, but changing it is not allowed. 8 | 9 | Preamble 10 | 11 | The licenses for most software are designed to take away your 12 | freedom to share and change it. By contrast, the GNU General Public 13 | License is intended to guarantee your freedom to share and change free 14 | software--to make sure the software is free for all its users. This 15 | General Public License applies to most of the Free Software 16 | Foundation's software and to any other program whose authors commit to 17 | using it. (Some other Free Software Foundation software is covered by 18 | the GNU Lesser General Public License instead.) You can apply it to 19 | your programs, too. 20 | 21 | When we speak of free software, we are referring to freedom, not 22 | price. Our General Public Licenses are designed to make sure that you 23 | have the freedom to distribute copies of free software (and charge for 24 | this service if you wish), that you receive source code or can get it 25 | if you want it, that you can change the software or use pieces of it 26 | in new free programs; and that you know you can do these things. 27 | 28 | To protect your rights, we need to make restrictions that forbid 29 | anyone to deny you these rights or to ask you to surrender the rights. 30 | These restrictions translate to certain responsibilities for you if you 31 | distribute copies of the software, or if you modify it. 32 | 33 | For example, if you distribute copies of such a program, whether 34 | gratis or for a fee, you must give the recipients all the rights that 35 | you have. You must make sure that they, too, receive or can get the 36 | source code. And you must show them these terms so they know their 37 | rights. 38 | 39 | We protect your rights with two steps: (1) copyright the software, and 40 | (2) offer you this license which gives you legal permission to copy, 41 | distribute and/or modify the software. 42 | 43 | Also, for each author's protection and ours, we want to make certain 44 | that everyone understands that there is no warranty for this free 45 | software. If the software is modified by someone else and passed on, we 46 | want its recipients to know that what they have is not the original, so 47 | that any problems introduced by others will not reflect on the original 48 | authors' reputations. 49 | 50 | Finally, any free program is threatened constantly by software 51 | patents. We wish to avoid the danger that redistributors of a free 52 | program will individually obtain patent licenses, in effect making the 53 | program proprietary. To prevent this, we have made it clear that any 54 | patent must be licensed for everyone's free use or not licensed at all. 55 | 56 | The precise terms and conditions for copying, distribution and 57 | modification follow. 58 | 59 | GNU GENERAL PUBLIC LICENSE 60 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 61 | 62 | 0. This License applies to any program or other work which contains 63 | a notice placed by the copyright holder saying it may be distributed 64 | under the terms of this General Public License. The "Program", below, 65 | refers to any such program or work, and a "work based on the Program" 66 | means either the Program or any derivative work under copyright law: 67 | that is to say, a work containing the Program or a portion of it, 68 | either verbatim or with modifications and/or translated into another 69 | language. (Hereinafter, translation is included without limitation in 70 | the term "modification".) Each licensee is addressed as "you". 71 | 72 | Activities other than copying, distribution and modification are not 73 | covered by this License; they are outside its scope. The act of 74 | running the Program is not restricted, and the output from the Program 75 | is covered only if its contents constitute a work based on the 76 | Program (independent of having been made by running the Program). 77 | Whether that is true depends on what the Program does. 78 | 79 | 1. You may copy and distribute verbatim copies of the Program's 80 | source code as you receive it, in any medium, provided that you 81 | conspicuously and appropriately publish on each copy an appropriate 82 | copyright notice and disclaimer of warranty; keep intact all the 83 | notices that refer to this License and to the absence of any warranty; 84 | and give any other recipients of the Program a copy of this License 85 | along with the Program. 86 | 87 | You may charge a fee for the physical act of transferring a copy, and 88 | you may at your option offer warranty protection in exchange for a fee. 89 | 90 | 2. You may modify your copy or copies of the Program or any portion 91 | of it, thus forming a work based on the Program, and copy and 92 | distribute such modifications or work under the terms of Section 1 93 | above, provided that you also meet all of these conditions: 94 | 95 | a) You must cause the modified files to carry prominent notices 96 | stating that you changed the files and the date of any change. 97 | 98 | b) You must cause any work that you distribute or publish, that in 99 | whole or in part contains or is derived from the Program or any 100 | part thereof, to be licensed as a whole at no charge to all third 101 | parties under the terms of this License. 102 | 103 | c) If the modified program normally reads commands interactively 104 | when run, you must cause it, when started running for such 105 | interactive use in the most ordinary way, to print or display an 106 | announcement including an appropriate copyright notice and a 107 | notice that there is no warranty (or else, saying that you provide 108 | a warranty) and that users may redistribute the program under 109 | these conditions, and telling the user how to view a copy of this 110 | License. (Exception: if the Program itself is interactive but 111 | does not normally print such an announcement, your work based on 112 | the Program is not required to print an announcement.) 113 | 114 | These requirements apply to the modified work as a whole. If 115 | identifiable sections of that work are not derived from the Program, 116 | and can be reasonably considered independent and separate works in 117 | themselves, then this License, and its terms, do not apply to those 118 | sections when you distribute them as separate works. But when you 119 | distribute the same sections as part of a whole which is a work based 120 | on the Program, the distribution of the whole must be on the terms of 121 | this License, whose permissions for other licensees extend to the 122 | entire whole, and thus to each and every part regardless of who wrote it. 123 | 124 | Thus, it is not the intent of this section to claim rights or contest 125 | your rights to work written entirely by you; rather, the intent is to 126 | exercise the right to control the distribution of derivative or 127 | collective works based on the Program. 128 | 129 | In addition, mere aggregation of another work not based on the Program 130 | with the Program (or with a work based on the Program) on a volume of 131 | a storage or distribution medium does not bring the other work under 132 | the scope of this License. 133 | 134 | 3. You may copy and distribute the Program (or a work based on it, 135 | under Section 2) in object code or executable form under the terms of 136 | Sections 1 and 2 above provided that you also do one of the following: 137 | 138 | a) Accompany it with the complete corresponding machine-readable 139 | source code, which must be distributed under the terms of Sections 140 | 1 and 2 above on a medium customarily used for software interchange; or, 141 | 142 | b) Accompany it with a written offer, valid for at least three 143 | years, to give any third party, for a charge no more than your 144 | cost of physically performing source distribution, a complete 145 | machine-readable copy of the corresponding source code, to be 146 | distributed under the terms of Sections 1 and 2 above on a medium 147 | customarily used for software interchange; or, 148 | 149 | c) Accompany it with the information you received as to the offer 150 | to distribute corresponding source code. (This alternative is 151 | allowed only for noncommercial distribution and only if you 152 | received the program in object code or executable form with such 153 | an offer, in accord with Subsection b above.) 154 | 155 | The source code for a work means the preferred form of the work for 156 | making modifications to it. For an executable work, complete source 157 | code means all the source code for all modules it contains, plus any 158 | associated interface definition files, plus the scripts used to 159 | control compilation and installation of the executable. However, as a 160 | special exception, the source code distributed need not include 161 | anything that is normally distributed (in either source or binary 162 | form) with the major components (compiler, kernel, and so on) of the 163 | operating system on which the executable runs, unless that component 164 | itself accompanies the executable. 165 | 166 | If distribution of executable or object code is made by offering 167 | access to copy from a designated place, then offering equivalent 168 | access to copy the source code from the same place counts as 169 | distribution of the source code, even though third parties are not 170 | compelled to copy the source along with the object code. 171 | 172 | 4. You may not copy, modify, sublicense, or distribute the Program 173 | except as expressly provided under this License. Any attempt 174 | otherwise to copy, modify, sublicense or distribute the Program is 175 | void, and will automatically terminate your rights under this License. 176 | However, parties who have received copies, or rights, from you under 177 | this License will not have their licenses terminated so long as such 178 | parties remain in full compliance. 179 | 180 | 5. You are not required to accept this License, since you have not 181 | signed it. However, nothing else grants you permission to modify or 182 | distribute the Program or its derivative works. These actions are 183 | prohibited by law if you do not accept this License. Therefore, by 184 | modifying or distributing the Program (or any work based on the 185 | Program), you indicate your acceptance of this License to do so, and 186 | all its terms and conditions for copying, distributing or modifying 187 | the Program or works based on it. 188 | 189 | 6. Each time you redistribute the Program (or any work based on the 190 | Program), the recipient automatically receives a license from the 191 | original licensor to copy, distribute or modify the Program subject to 192 | these terms and conditions. You may not impose any further 193 | restrictions on the recipients' exercise of the rights granted herein. 194 | You are not responsible for enforcing compliance by third parties to 195 | this License. 196 | 197 | 7. If, as a consequence of a court judgment or allegation of patent 198 | infringement or for any other reason (not limited to patent issues), 199 | conditions are imposed on you (whether by court order, agreement or 200 | otherwise) that contradict the conditions of this License, they do not 201 | excuse you from the conditions of this License. If you cannot 202 | distribute so as to satisfy simultaneously your obligations under this 203 | License and any other pertinent obligations, then as a consequence you 204 | may not distribute the Program at all. For example, if a patent 205 | license would not permit royalty-free redistribution of the Program by 206 | all those who receive copies directly or indirectly through you, then 207 | the only way you could satisfy both it and this License would be to 208 | refrain entirely from distribution of the Program. 209 | 210 | If any portion of this section is held invalid or unenforceable under 211 | any particular circumstance, the balance of the section is intended to 212 | apply and the section as a whole is intended to apply in other 213 | circumstances. 214 | 215 | It is not the purpose of this section to induce you to infringe any 216 | patents or other property right claims or to contest validity of any 217 | such claims; this section has the sole purpose of protecting the 218 | integrity of the free software distribution system, which is 219 | implemented by public license practices. Many people have made 220 | generous contributions to the wide range of software distributed 221 | through that system in reliance on consistent application of that 222 | system; it is up to the author/donor to decide if he or she is willing 223 | to distribute software through any other system and a licensee cannot 224 | impose that choice. 225 | 226 | This section is intended to make thoroughly clear what is believed to 227 | be a consequence of the rest of this License. 228 | 229 | 8. If the distribution and/or use of the Program is restricted in 230 | certain countries either by patents or by copyrighted interfaces, the 231 | original copyright holder who places the Program under this License 232 | may add an explicit geographical distribution limitation excluding 233 | those countries, so that distribution is permitted only in or among 234 | countries not thus excluded. In such case, this License incorporates 235 | the limitation as if written in the body of this License. 236 | 237 | 9. The Free Software Foundation may publish revised and/or new versions 238 | of the General Public License from time to time. Such new versions will 239 | be similar in spirit to the present version, but may differ in detail to 240 | address new problems or concerns. 241 | 242 | Each version is given a distinguishing version number. If the Program 243 | specifies a version number of this License which applies to it and "any 244 | later version", you have the option of following the terms and conditions 245 | either of that version or of any later version published by the Free 246 | Software Foundation. If the Program does not specify a version number of 247 | this License, you may choose any version ever published by the Free Software 248 | Foundation. 249 | 250 | 10. If you wish to incorporate parts of the Program into other free 251 | programs whose distribution conditions are different, write to the author 252 | to ask for permission. For software which is copyrighted by the Free 253 | Software Foundation, write to the Free Software Foundation; we sometimes 254 | make exceptions for this. Our decision will be guided by the two goals 255 | of preserving the free status of all derivatives of our free software and 256 | of promoting the sharing and reuse of software generally. 257 | 258 | NO WARRANTY 259 | 260 | 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 261 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 262 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 263 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 264 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 265 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 266 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 267 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 268 | REPAIR OR CORRECTION. 269 | 270 | 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 271 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 272 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 273 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 274 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 275 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 276 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 277 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 278 | POSSIBILITY OF SUCH DAMAGES. 279 | 280 | END OF TERMS AND CONDITIONS 281 | 282 | How to Apply These Terms to Your New Programs 283 | 284 | If you develop a new program, and you want it to be of the greatest 285 | possible use to the public, the best way to achieve this is to make it 286 | free software which everyone can redistribute and change under these terms. 287 | 288 | To do so, attach the following notices to the program. It is safest 289 | to attach them to the start of each source file to most effectively 290 | convey the exclusion of warranty; and each file should have at least 291 | the "copyright" line and a pointer to where the full notice is found. 292 | 293 | 294 | Copyright (C) 295 | 296 | This program is free software; you can redistribute it and/or modify 297 | it under the terms of the GNU General Public License as published by 298 | the Free Software Foundation; either version 2 of the License, or 299 | (at your option) any later version. 300 | 301 | This program is distributed in the hope that it will be useful, 302 | but WITHOUT ANY WARRANTY; without even the implied warranty of 303 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 304 | GNU General Public License for more details. 305 | 306 | You should have received a copy of the GNU General Public License along 307 | with this program; if not, write to the Free Software Foundation, Inc., 308 | 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 309 | 310 | Also add information on how to contact you by electronic and paper mail. 311 | 312 | If the program is interactive, make it output a short notice like this 313 | when it starts in an interactive mode: 314 | 315 | Gnomovision version 69, Copyright (C) year name of author 316 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 317 | This is free software, and you are welcome to redistribute it 318 | under certain conditions; type `show c' for details. 319 | 320 | The hypothetical commands `show w' and `show c' should show the appropriate 321 | parts of the General Public License. Of course, the commands you use may 322 | be called something other than `show w' and `show c'; they could even be 323 | mouse-clicks or menu items--whatever suits your program. 324 | 325 | You should also get your employer (if you work as a programmer) or your 326 | school, if any, to sign a "copyright disclaimer" for the program, if 327 | necessary. Here is a sample; alter the names: 328 | 329 | Yoyodyne, Inc., hereby disclaims all copyright interest in the program 330 | `Gnomovision' (which makes passes at compilers) written by James Hacker. 331 | 332 | , 1 April 1989 333 | Ty Coon, President of Vice 334 | 335 | This General Public License does not permit incorporating your program into 336 | proprietary programs. If your program is a subroutine library, you may 337 | consider it more useful to permit linking proprietary applications with the 338 | library. If this is what you want to do, use the GNU Lesser General 339 | Public License instead of this License. 340 | --------------------------------------------------------------------------------