├── .clang-format ├── .gitignore ├── .gitmodules ├── 3rdparty └── emacsy │ ├── .dir-locals.el │ ├── .gitignore │ ├── AUTHORS │ ├── COPYING │ ├── COPYING.CC-BY-SA │ ├── ChangeLog │ ├── HACKING │ ├── INSTALL │ ├── Makefile.am │ ├── NEWS │ ├── README │ ├── TODO │ ├── autogen.sh │ ├── build-aux │ ├── config.rpath │ ├── git-version-gen │ ├── gitlog-to-changelog │ └── pre-inst-env.in │ ├── configure.ac │ ├── doc │ ├── api.texi │ ├── emacsy.texi │ ├── fdl-1.3.texi │ ├── hello-emacsy.texi │ └── images │ │ ├── README │ │ ├── child-window-diagram.graffle │ │ ├── child-window-diagram.pdf │ │ ├── emacsy-logo.pdf │ │ ├── emacsy-logo.png │ │ ├── minimal-emacsy-example.png │ │ ├── minimal-emacsy-figure.pdf │ │ ├── screenshot-small.png │ │ ├── screenshot.png │ │ ├── the-garden-1.png │ │ ├── the-garden-2.png │ │ ├── the-garden-3.png │ │ ├── the-garden-4.png │ │ ├── the-garden-5.png │ │ ├── the-garden-6.png │ │ ├── the-garden-7.png │ │ ├── the-garden-8.png │ │ ├── the-garden.pdf │ │ ├── the-garden.png │ │ ├── window-diagram.graffle │ │ └── window-diagram.pdf │ ├── emacsy │ ├── advice.scm │ ├── agenda.scm │ ├── block.scm │ ├── buffer.scm │ ├── command.scm │ ├── core.scm │ ├── coroutine.scm │ ├── cursor-list.scm │ ├── emacsy.c │ ├── emacsy.h │ ├── emacsy.pc.in │ ├── emacsy.scm │ ├── event.scm │ ├── help.scm │ ├── introspection.scm │ ├── job.scm │ ├── kbd-macro.scm │ ├── keymap.scm │ ├── klecl.scm │ ├── line-pragma.scm │ ├── minibuffer.scm │ ├── mode.scm │ ├── mru-stack.scm │ ├── self-doc.scm │ ├── text.scm │ ├── util.scm │ ├── vector-math.scm │ ├── window.scm │ └── windows.scm │ ├── example │ ├── emacsy-webkit-gtk-w-buffers.c │ ├── emacsy-webkit-gtk-w-buffers.scm │ ├── emacsy-webkit-gtk-w-windows.c │ ├── emacsy-webkit-gtk-w-windows.scm │ ├── emacsy-webkit-gtk.c │ ├── emacsy-webkit-gtk.scm │ ├── hello-emacsy.c │ └── hello-emacsy.scm │ ├── guix.scm │ ├── scripts │ └── doc-snarf.scm │ └── test │ ├── advice.scm │ ├── block.scm │ ├── buffer.scm │ ├── check.scm │ ├── command.scm │ ├── core.scm │ ├── coroutine.scm │ ├── emacsy.scm │ ├── event.scm │ ├── help.scm │ ├── job.scm │ ├── kbd-macro.scm │ ├── keymap.scm │ ├── klecl.scm │ ├── minibuffer-test-dir │ ├── bin │ │ └── run-test │ ├── empty-dir │ │ └── .dummy │ ├── exam │ │ └── .dummy │ ├── minibuffer-a │ └── minibuffer-b │ ├── minibuffer.scm │ ├── mru-stack.scm │ ├── self-doc.scm │ ├── text.scm │ ├── window.scm │ └── windows.scm ├── CMakeLists.txt ├── LICENSE ├── README.org ├── cmake ├── FindGuile.cmake └── FindReadline.cmake ├── conanfile.txt ├── data └── monospace.ttf ├── extensions ├── CMakeLists.txt ├── tree-sitter-cc │ ├── CMakeLists.txt │ └── tree-sitter-cc.c └── tree-sitter │ ├── CMakeLists.txt │ └── tree-sitter.cpp ├── include ├── color_value.h ├── font.h ├── intern_string.h ├── keymap.h ├── renderer.h ├── rope.h ├── shader_program.h ├── singleton.h └── vector2.h ├── modules ├── emacsy └── zem │ ├── core │ ├── buffer.scm │ ├── commands.scm │ ├── faces.scm │ ├── font-lock.scm │ ├── mode.scm │ └── text-prop.scm │ ├── init.scm │ ├── progmodes │ ├── cc-mode.scm │ └── prog-mode.scm │ ├── syntax │ └── tree-sitter.scm │ ├── themes │ ├── doom-one.scm │ ├── monokai.scm │ └── theme.scm │ ├── ui │ ├── buffer-view.scm │ ├── minibuffer-view.scm │ ├── root-view.scm │ ├── style.scm │ └── view.scm │ └── util │ ├── avl.scm │ └── plist.scm ├── run.sh └── src ├── api ├── api.cpp ├── font.cpp ├── renderer.cpp └── rope.cpp ├── font.cpp ├── intern_string.cpp ├── keymap.c ├── main.cpp ├── renderer.cpp ├── rope.cpp └── shader_program.cpp /.clang-format: -------------------------------------------------------------------------------- 1 | BasedOnStyle: LLVM 2 | PointerAlignment: Left 3 | 4 | UseTab: Never 5 | IndentWidth: 4 6 | TabWidth: 4 7 | 8 | MaxEmptyLinesToKeep: 1 9 | 10 | AllowShortFunctionsOnASingleLine: true 11 | AllowShortIfStatementsOnASingleLine: true 12 | AllowShortCaseLabelsOnASingleLine: false 13 | 14 | AlignTrailingComments: true 15 | AlignEscapedNewlines: true 16 | 17 | SpacesInParentheses: false 18 | 19 | BreakBeforeBraces: Custom 20 | BraceWrapping: 21 | AfterClass: false 22 | AfterControlStatement: false 23 | AfterEnum: false 24 | AfterFunction: true 25 | AfterNamespace: false 26 | AfterStruct: false 27 | AfterUnion: false 28 | AfterExternBlock: true 29 | BeforeCatch: false 30 | BeforeElse: false 31 | IndentBraces: false 32 | SplitEmptyFunction: false 33 | SplitEmptyRecord: false 34 | SplitEmptyNamespace: false 35 | 36 | IndentCaseLabels: false 37 | 38 | ReflowComments: true 39 | 40 | NamespaceIndentation: None 41 | AccessModifierOffset: -4 -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | build 2 | 3 | .ccls-cache 4 | compile_commands.json 5 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "extensions/tree-sitter-cpp/tree-sitter-cpp"] 2 | path = extensions/tree-sitter-cc/tree-sitter-cpp 3 | url = https://github.com/tree-sitter/tree-sitter-cpp.git 4 | -------------------------------------------------------------------------------- /3rdparty/emacsy/.dir-locals.el: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile. 2 | ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen 3 | ;;; 4 | ;;; This file is part of Emacsy. 5 | ;;; 6 | ;;; Emacsy is free software; you can redistribute it and/or modify it 7 | ;;; under the terms of the GNU General Public License as published by 8 | ;;; the Free Software Foundation; either version 3 of the License, or (at 9 | ;;; your option) any later version. 10 | ;;; 11 | ;;; Emacsy is distributed in the hope that it will be useful, but 12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of 13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | ;;; GNU General Public License for more details. 15 | ;;; 16 | ;;; You should have received a copy of the GNU General Public License 17 | ;;; along with Emacsy. If not, see . 18 | 19 | ;; The GNU project defaults. These are also the GNU Emacs defaults. 20 | ;; Re-asserting theme here, however, as a courtesy for setups that use 21 | ;; a global override. 22 | ( 23 | ;; For writing GNU C code, see 24 | ;; https://www.gnu.org/prep/standards/html_node/Writing-C.html 25 | (c-mode . ((c-file-style . "gnu") 26 | (indent-tabs-mode . nil))) 27 | 28 | (makefile-mode . ((indent-tabs-mode . t))) 29 | 30 | (nil . ((indent-tabs-mode . nil) 31 | (fill-column . 72) 32 | (eval . (add-hook 'before-save-hook 'delete-trailing-whitespace nil t)))) 33 | 34 | (scheme-mode 35 | . 36 | ((eval . (put 'with-buffer 'scheme-indent-function 1)) 37 | (eval . (put 'save-excursion 'scheme-indent-function 1)) 38 | (eval 39 | . 40 | (progn 41 | (defun prefix-dir-locals-dir (elt) 42 | (concat (locate-dominating-file buffer-file-name ".dir-locals.el") elt)) 43 | (mapcar 44 | (lambda (dir) (add-to-list 'geiser-guile-load-path dir)) 45 | (mapcar 46 | #'prefix-dir-locals-dir 47 | '("." "test"))))))) 48 | 49 | (texinfo-mode . ((indent-tabs-mode . nil) 50 | (fill-column . 72)))) 51 | -------------------------------------------------------------------------------- /3rdparty/emacsy/.gitignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | Makefile.in 3 | *.c.x 4 | *.defs 5 | *.go 6 | *.la 7 | *.lo 8 | *.log 9 | *.o 10 | *.trs 11 | .dirstamp 12 | .deps* 13 | .libs* 14 | TAGS 15 | /aclocal.m4 16 | /autom4te.cache/* 17 | /build-aux/compile 18 | /build-aux/config.guess 19 | /build-aux/config.sub 20 | /build-aux/depcomp 21 | /build-aux/install-sh 22 | /build-aux/ltmain.sh 23 | /build-aux/missing 24 | /build-aux/test-driver 25 | /config.log 26 | /config.status 27 | /configure 28 | /libtool 29 | /pre-inst-env 30 | 31 | /emacsy/emacsy.pc 32 | /hello-emacsy 33 | /emacsy-webkit-gtk 34 | /emacsy-webkit-gtk-w-buffers 35 | /emacsy-webkit-gtk-w-windows 36 | /build-aux/mdate-sh 37 | /build-aux/texinfo.tex 38 | /doc/emacsy.info 39 | stamp-vti 40 | /doc/version.texi 41 | /doc/emacsy.pdf 42 | /doc/emacsy.t2p 43 | -------------------------------------------------------------------------------- /3rdparty/emacsy/AUTHORS: -------------------------------------------------------------------------------- 1 | Shane Celis 2 | Jan (janneke) Nieuwenhuizen 3 | Amar Singh -------------------------------------------------------------------------------- /3rdparty/emacsy/ChangeLog: -------------------------------------------------------------------------------- 1 | -*- org -*- 2 | 3 | #+TITLE: ChangeLog 4 | 5 | Copyright © 2019 Jan (janneke) Nieuwenhuizen 6 | 7 | Copying and distribution of this file, with or without modification, 8 | are permitted in any medium without royalty provided the copyright 9 | notice and this notice are preserved. 10 | 11 | Normally a ChangeLog is generated at "make dist" time and available in 12 | source tarballs. 13 | -------------------------------------------------------------------------------- /3rdparty/emacsy/HACKING: -------------------------------------------------------------------------------- 1 | #+COMMENT: -*- org -*- 2 | #+TITLE: Hacking Emacsy 3 | 4 | * Committing 5 | 6 | Please write commit logs in the [[info:Standards#Change%20Logs][ChangeLog]] format, you can check the 7 | commit history for examples. 8 | 9 | * Documentation/API/Noweb 10 | 11 | In 0.3 Noweb was removed; the code was split into pure Guile scheme 12 | source code and separate texinfo documentation. This setup is now 13 | functional and needs lots of work and cleaning up. 14 | 15 | The API-documentation is being snarfed using [[file:scripts/doc-snarf.scm][scripts/doc-snarf.scm]], a 16 | heavily hacked version of the script that comes with Guile. See the 17 | script for some minimal documentation of how it works and what it does. 18 | 19 | Use `make doc-snarf' to update the snarfed documentation. 20 | 21 | The miminal, empty comment that doc-snarf uses to generate 22 | API-documentation for a function is ;;., like so 23 | 24 | #+BEGIN_EXAMPLE 25 | ;;. 26 | (define (undocumented-api-function) ... ) 27 | #+END_EXAMPLE 28 | 29 | Using the empty description is a placeholder, we will need some actual 30 | documentation in the comment there. The original doc-snarf uses 31 | whitespace for that. That does not work for us; we have Emacs remove 32 | trailing whitespace from our code. 33 | 34 | We still have to figure out exactly how to do this as we probably want 35 | the same documentation to be available via the self-documenting Emacsy 36 | help system. Have doc-snarf (also) parse docstrings? 37 | 38 | * Texlive 39 | 40 | If you are not building a release or checking that the PDF documentation 41 | still builds, you may want to setup a Guix environment without texlive 42 | (a ~4GB download). Try something like 43 | 44 | #+BEGIN_EXAMPLE 45 | guix environment -l guix.scm --with-input=texlive=coreutils 46 | #+END_EXAMPLE 47 | 48 | * Example Usage 49 | 50 | Emacsy usage is being explored in the [[https://savannah.nongnu.org/projects/nomad][Nomad extensible web browser]] and 51 | in [[https://gitlab.com/janneke/guimax][Guimax]] 52 | 53 | Please send Emacsy bug reports to [[mailto:guile-user@gnu.org][guile-user@gnu.org]]. 54 | 55 | * Legalese 56 | Copyright © 2019 Jan (janneke) Nieuwenhuizen <[[mailto:janneke@gnu.org][janneke@gnu.org]]> 57 | 58 | Copying and distribution of this file, with or without modification, 59 | are permitted in any medium without royalty provided the copyright 60 | notice and this notice are preserved. 61 | -------------------------------------------------------------------------------- /3rdparty/emacsy/INSTALL: -------------------------------------------------------------------------------- 1 | -*- org -*- 2 | #+TITLE: Building and Installing Emacsy 3 | 4 | * Get it 5 | #+BEGIN_EXAMPLE 6 | git clone https://git.savannah.nongnu.org/git/emacsy.git 7 | #+END_EXAMPLE 8 | or 9 | #+BEGIN_EXAMPLE 10 | wget http://download.savannah.nongnu.org/releases/emacsy/emacsy-0.4.1.tar.gz 11 | #+END_EXAMPLE 12 | 13 | * Prerequisites 14 | ** GNU Guix 15 | #+BEGIN_EXAMPLE 16 | guix environment -l guix.scm 17 | #+END_EXAMPLE 18 | 19 | See [[file:guix.scm][guix.scm]] for more options. 20 | 21 | ** Other GNU/Linux, without the Guix package manager 22 | - [[http://www.gnu.org/software/guile/][GNU Guile Scheme]], version 2.2.4 is know to work. 23 | - [[http://www.nongnu.org/guile-lib/][guile-lib]], version 0.2.6.1 is known to work. 24 | - [[http://www.gnu.org/software/make][GNU Make]], version 4.2.1 is known to work. 25 | - [[http://www.gnu.org/software/gcc][GNU Gcc,]] version 5.5.0 is known to work. 26 | 27 | *** Optional 28 | - [[http://www.gnu.org/software/autoconf][Autconf]], [[http://www.gnu.org/software/automake][Automake]], [[http://www.gnu.org/software/libtool][Libtool]], and [[https://www.freedesktop.org/wiki/Software/pkg-config][pkg-config]] to build from git. 29 | - [[http://www.gnu.org/software/texinfo][GNU Texinfo]] to build the documentation. 30 | - [[https://freeglut.sourceforge.net][FreeGLUT]], for the hello-emacsy example. 31 | - [[https://webkitgtk.org][WebKitGTK]], to build the bare bones Emacsy Web browser examples. 32 | 33 | ** Build it 34 | #+BEGIN_EXAMPLE 35 | ./autogen.sh 36 | ./configure 37 | make 38 | #+END_EXAMPLE 39 | 40 | ** Documentation 41 | #+BEGIN_EXAMPLE 42 | make info 43 | make pdf 44 | #+END_EXAMPLE 45 | 46 | ** Install it 47 | #+BEGIN_EXAMPLE 48 | make install 49 | #+END_EXAMPLE 50 | 51 | * legalese 52 | Copyright © 2019 Jan (janneke) Nieuwenhuizen 53 | 54 | Copying and distribution of this file, with or without modification, 55 | are permitted in any medium without royalty provided the copyright 56 | notice and this notice are preserved. 57 | -------------------------------------------------------------------------------- /3rdparty/emacsy/NEWS: -------------------------------------------------------------------------------- 1 | -*- org -*- 2 | #+TITLE: Emacsy NEWS – history of user-visible changes 3 | #+STARTUP: content hidestars 4 | 5 | Copyright © 2019 Jan (janneke) Nieuwenhuizen 6 | 7 | Copying and distribution of this file, with or without modification, 8 | are permitted in any medium without royalty provided the copyright 9 | notice and this notice are preserved. 10 | 11 | Please send Emacsy bug reports to guile-user@gnu.org. 12 | 13 | * Changes in 0.4.1 since 0.4 14 | ** Core 15 | *** A missing export for `lookup-key' has been added. 16 | ** Distribution 17 | *** The tarball release includes the test suite again. 18 | * Changes in 0.4 since 0.3 19 | ** Distribution 20 | *** Emacsy moved to http://savannah.nongnu.org/projects/emacsy 21 | *** Missing copyright and Licence headers have been added. 22 | *** A ChangeLog is now generated from the commit messages. 23 | ** Core 24 | *** now supports full text editng beyond minibuffer. 25 | *** The minibuffer now supports file-name completion. 26 | *** ‘kill-buffer’ is now safe. 27 | **** 15 New commands: 28 | backard-kill-word, exchange-point-and-mark, find-file, kill-line, 29 | kill-region, kill-word, mark-whole-buffer, move-beginning-of-line, 30 | move-end-of-line, new-buffer, next-line, previous-line, 31 | set-mark-command, yank, yank-pop. 32 | **** 18 New functions: 33 | backard-line, beginning-of-line, buffer-next!, buffer-previous!, 34 | buffer-substring, contract-file-name, current-column, delete-line, 35 | delete-region, end-of-line, expand-file-name, 36 | file-name-completion-function forward-line, line-length, mark, 37 | other-buffer!, save-excursion, set-mark. 38 | **** 5 New variables: 39 | default-directory, fundamental-map, fundamental-mode, kill-ring, 40 | scratch. 41 | ** Noteworthy bug fixes 42 | *** next-buffer and previous-buffer now have Emacs semantics. 43 | * Changes in 0.3 since 0.2 44 | ** Distribution 45 | *** Noweb has been removed, source code is been promoted to canonical source. 46 | *** Copyright and license notices have been added. 47 | *** Hello and WebKitGTK Examples are now part of Emacsy. 48 | *** Documentation is now available in GNU texinfo. 49 | *** Emacsy now uses GNU style READMEs. 50 | *** The build has been rewritten and is now non-recursive. 51 | * Changes in 0.2 since 0.1.3 52 | ** Core 53 | *** Emacsy now has a Guix package and is released with GNU Guix. 54 | *** Emacsy now supports Guile 2.2, Gtk+3, WebKit2Gtk-4.0. 55 | *** Emacsy is less noisy, again. 56 | ** C API 57 | *** The C API now uses the EMACSY_ prefix C constants (WAS: EY_). 58 | * Changes in 0.1.3 since 0.1.2 59 | ** Core 60 | *** Emacsy now supports universal argument (C-u ...). 61 | *** Emacsy now supports a non-interactive batch mode. 62 | *** Emacsy now uses Guile-2d's coroutines and agenda. 63 | *** Emacsy is less noisy. 64 | *** Emacsy now has a self-doc interface. 65 | ** Scheme API 66 | *** emacsy-initialize now takes a boolean: emacsy-interactive?. 67 | ** C API 68 | *** The C API now uses the EMACSY_ prefix C constants (WAS: EY_). 69 | *** emacsy_initialize now takes flags: EMACSY_INTERACTIVE EMACSY_NON_INTERACTIVE. 70 | -------------------------------------------------------------------------------- /3rdparty/emacsy/README: -------------------------------------------------------------------------------- 1 | #+COMMENT: -*- org -*- 2 | #+TITLE: About Emacsy 3 | 4 | #+SUBTITLE: an embeddable Emacs-like library using GNU Guile 5 | 6 | Emacsy is an embeddable Emacs-like library using [[http://www.gnu.org/software/guile/][GNU Guile Scheme]]. It 7 | was a [[http://www.kickstarter.com/projects/568774734/emacsy-an-embeddable-emacs/?ref=kicktraq][kickstarter project]], and it also was a [[https://google-melange.appspot.com/gsoc/proposal/review/google/gsoc2013/shanecelis/1][Google Summer of Code 2013 project]]. 8 | 9 | I will be working with Ludovic Courtès from the [[http://www.gnu.org/gnu/thegnuproject.html][GNU Project]]. Keep 10 | abreast of its development by watching this repository or following me 11 | on twitter [@shanecelis](https://twitter.com/shanecelis). 12 | 13 | Get it 14 | #+BEGIN_EXAMPLE 15 | git clone https://git.savannah.nongnu.org/git/emacsy.git 16 | #+END_EXAMPLE 17 | 18 | build it 19 | #+BEGIN_EXAMPLE 20 | guix environment -l guix.scm 21 | ./autogen.sh 22 | ./configure 23 | make 24 | ./pre-inst-env hello-emacsy 25 | #+END_EXAMPLE 26 | 27 | and 28 | 29 | #+BEGIN_EXAMPLE 30 | ./pre-inst-env emacsy-webkit-gtk 31 | #+END_EXAMPLE 32 | 33 | To build a minimal Emacsy, perhaps packaging it for a new distro: 34 | #+BEGIN_EXAMPLE 35 | ./autogen.sh 36 | ./configure --with-examples=no 37 | make 38 | #+END_EXAMPLE 39 | 40 | Emacsy is free software, it is distributed under the terms of the GNU 41 | General Public Licence version 3 or later. See the file [[file:COPYING][COPYING]]. 42 | 43 | * WARNING/Usage 44 | 45 | This project is currently in development. It is as alpha as can be. 46 | Not meant for general consumption yet. Contributors, welcome! 47 | 48 | Emacsy usage is being explored in the [[https://www.nongnu.org/nomad/][Nomad extensible web browser]] and 49 | in [[https://gitlab.com/janneke/guimax][Guimax]] 50 | 51 | * Bugs 52 | 53 | Please send Emacsy bug reports to [[mailto:guile-user@gnu.org][guile-user@gnu.org]]. 54 | 55 | * legalese 56 | Copyright © 2012, 2013 Shane Celis 57 | Copyright © 2019 Jan (janneke) Nieuwenhuizen 58 | 59 | Copying and distribution of this file, with or without modification, 60 | are permitted in any medium without royalty provided the copyright 61 | notice and this notice are preserved. 62 | -------------------------------------------------------------------------------- /3rdparty/emacsy/autogen.sh: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | autoreconf -vif 3 | -------------------------------------------------------------------------------- /3rdparty/emacsy/build-aux/pre-inst-env.in: -------------------------------------------------------------------------------- 1 | #! @BASH@ 2 | 3 | # Emacsy --- An embeddable Emacs-like library using GNU Guile. 4 | # Copyright (C) 2019 Jan Nieuwenhuizen 5 | # 6 | # This file is part of Emacsy. 7 | # 8 | # This program is free software: you can redistribute it and/or modify 9 | # it under the terms of the GNU General Public License as published by 10 | # the Free Software Foundation, either version 3 of the License, or 11 | # (at your option) any later version. 12 | # 13 | # This program is distributed in the hope that it will be useful, 14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | # GNU General Public License for more details. 17 | # 18 | # You should have received a copy of the GNU General Public License 19 | # along with this program. If not, see . 20 | 21 | # Usage: ./pre-inst-env COMMAND ARG... 22 | # 23 | # Run COMMAND in a pre-installation environment. Typical use is 24 | # "./pre-inst-env ./hello-emacsy". 25 | 26 | ABS_TOP_SRCDIR="@abs_top_srcdir@" 27 | EMACSY_SYSCONFDIR="@abs_top_srcdir@/example" 28 | GUILE_LOAD_PATH="@abs_top_srcdir@:@abs_top_builddir@:@abs_top_srcdir@/test${GUILE_LOAD_PATH+:}$GUILE_LOAD_PATH" 29 | GUILE_LOAD_COMPILED_PATH="@abs_top_builddir@${GUILE_LOAD_COMPILED_PATH+:}$GUILE_LOAD_COMPILED_PATH" 30 | 31 | # To allow ./pre-inst-env hello-emacsy...hmm 32 | PATH="@abs_top_builddir@":$PATH 33 | 34 | export ABS_TOP_SRCDIR EMACSY_SYSCONFDIR GUILE_LOAD_PATH GUILE_LOAD_COMPILED_PATH 35 | 36 | exec "$@" 37 | -------------------------------------------------------------------------------- /3rdparty/emacsy/configure.ac: -------------------------------------------------------------------------------- 1 | # Emacsy --- An embeddable Emacs-like library using GNU Guile. 2 | # Copyright (C) 2012, 2013 Shane Celis 3 | # Copyright (C) 2019 Jan Nieuwenhuizen 4 | # 5 | # This file is part of Emacsy. 6 | # 7 | # This program is free software: you can redistribute it and/or modify 8 | # it under the terms of the GNU General Public License as published by 9 | # the Free Software Foundation, either version 3 of the License, or 10 | # (at your option) any later version. 11 | # 12 | # This program is distributed in the hope that it will be useful, 13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | # GNU General Public License for more details. 16 | # 17 | # You should have received a copy of the GNU General Public License 18 | # along with this program. If not, see . 19 | 20 | AC_INIT([Emacsy], 21 | [m4_esyscmd([build-aux/git-version-gen .tarball-version])], 22 | [guile-user@gnu.org], 23 | [emacsy]) 24 | AC_CONFIG_AUX_DIR([build-aux]) 25 | 26 | AM_INIT_AUTOMAKE([-Wall foreign -Wno-portability parallel-tests subdir-objects]) 27 | AM_SILENT_RULES([yes]) 28 | 29 | AC_PROG_CC_C99 30 | AC_PROG_CC_C_O 31 | AC_PROG_LIBTOOL 32 | 33 | AC_PATH_PROG([BASH], [bash]) 34 | AC_SUBST([BASH]) 35 | 36 | GUILE_PKG([3.0 2.2 2.0]) 37 | GUILE_PROGS 38 | 39 | #GUILE_SITE_DIR 40 | guilemoduledir="${datarootdir}/guile/site/$GUILE_EFFECTIVE_VERSION" 41 | guileobjectdir="${libdir}/guile/$GUILE_EFFECTIVE_VERSION/site-ccache" 42 | AC_SUBST([guilemoduledir]) 43 | AC_SUBST([guileobjectdir]) 44 | 45 | GUILE_FLAGS 46 | AC_ARG_VAR([GUILD], [guild (Guile compiler) command]) 47 | AS_IF([test "x$GUILD" = "x"], 48 | [PKG_CHECK_VAR([GUILD], [guile-$GUILE_EFFECTIVE_VERSION], [guild], [], 49 | [AC_MSG_ERROR(m4_normalize([ 50 | 'guild' binary not found; please check your Guile installation.]))])]) 51 | AC_PATH_PROGS([guile_snarf], [guile-snarf guile-snarf$GUILE_EFFECTIVE_VERSION]) 52 | AC_SUBST(guile_snarf) 53 | 54 | GUILE_MODULE_AVAILABLE([have_guile_lib], [(debugging assert)]) 55 | if test "x$have_guile_lib" != "xyes"; then 56 | AC_MSG_ERROR([guile-lib is missing; please install it.]) 57 | fi 58 | 59 | AC_HEADER_STDC 60 | 61 | AC_CHECK_PROG([HAVE_PDFLATEX], [pdflatex], [yes], [no]) 62 | AM_CONDITIONAL([HAVE_PDFLATEX], [test x$HAVE_PDFLATEX = xyes]) 63 | 64 | dnl '--with-examples=no' to disable building examples 65 | AC_ARG_WITH([examples], 66 | AS_HELP_STRING([--without-examples], [Ignore and don't build examples])) 67 | 68 | AS_IF([test x$with_examples != xno], 69 | [BUILD_EXAMPLES=yes], 70 | [BUILD_EXAMPLES=no]) 71 | 72 | PKG_CHECK_MODULES([FREEGLUT], [freeglut >= 3.0], [HAVE_FREEGLUT=yes], [HAVE_FREEGLUT=no]) 73 | PKG_CHECK_MODULES([GL], [gl >= 18.0.0], [HAVE_GL=yes], [HAVE_GL=no]) 74 | PKG_CHECK_MODULES([GLU], [glu >= 9.0.0], [HAVE_GLU=yes], [HAVE_GLU=no]) 75 | AM_CONDITIONAL([HELLO_EMACSY], [test x$BUILD_EXAMPLES$HAVE_FREEGLUT$HAVE_GL$HAVE_GLU = xyesyesyesyes]) 76 | 77 | PKG_CHECK_MODULES([WEBKIT], [webkit2gtk-4.0], [HAVE_WEBKIT=yes], [HAVE_WEBKIT=no]) 78 | AM_CONDITIONAL([EMACSY_WEBKIT_GTK], [test x$BUILD_EXAMPLES$HAVE_WEBKIT = xyesyes]) 79 | 80 | AC_CONFIG_FILES([Makefile]) 81 | AC_CONFIG_FILES([emacsy/emacsy.pc]) 82 | AC_CONFIG_FILES([pre-inst-env:build-aux/pre-inst-env.in], 83 | [chmod +x pre-inst-env]) 84 | AC_OUTPUT 85 | -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/README: -------------------------------------------------------------------------------- 1 | -*- org -*- 2 | #+TITLE: Emacsy 3 | 4 | These images 5 | 6 | child-window-diagram.graffle 7 | child-window-diagram.pdf 8 | emacsy-logo.pdf 9 | emacsy-logo.png 10 | minimal-emacsy-example.png 11 | minimal-emacsy-figure.pdf 12 | screenshot-small.png 13 | screenshot.png 14 | the-garden-1.png 15 | the-garden-2.png 16 | the-garden-3.png 17 | the-garden-4.png 18 | the-garden-5.png 19 | the-garden-6.png 20 | the-garden-7.png 21 | the-garden-8.png 22 | the-garden.pdf 23 | the-garden.png 24 | window-diagram.graffle 25 | window-diagram.pdf 26 | 27 | are 28 | 29 | Copyright (C) 2012, 2013 Shane Celis 30 | CC-BY-SA 3.0 -- Creative Commons Attribution-ShareAlike 3.0 31 | 32 | * legalese 33 | Copyright © 2019 Jan (janneke) Nieuwenhuizen 34 | 35 | Copying and distribution of this file, with or without modification, 36 | are permitted in any medium without royalty provided the copyright 37 | notice and this notice are preserved. 38 | -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/child-window-diagram.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/child-window-diagram.pdf -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/emacsy-logo.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/emacsy-logo.pdf -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/emacsy-logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/emacsy-logo.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/minimal-emacsy-example.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/minimal-emacsy-example.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/minimal-emacsy-figure.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/minimal-emacsy-figure.pdf -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/screenshot-small.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/screenshot-small.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/screenshot.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/the-garden-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/the-garden-1.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/the-garden-2.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/the-garden-2.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/the-garden-3.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/the-garden-3.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/the-garden-4.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/the-garden-4.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/the-garden-5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/the-garden-5.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/the-garden-6.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/the-garden-6.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/the-garden-7.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/the-garden-7.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/the-garden-8.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/the-garden-8.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/the-garden.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/the-garden.pdf -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/the-garden.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/the-garden.png -------------------------------------------------------------------------------- /3rdparty/emacsy/doc/images/window-diagram.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/doc/images/window-diagram.pdf -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/advice.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | ;;; Commentary: 21 | 22 | ;; @node Advice 23 | ;; @section Advice 24 | 25 | ;; @quotation 26 | ;; Wise men don't need advice. Fools won't take it. 27 | ;; @author Benjamin Franklin 28 | ;; @end quotation 29 | 30 | ;; @c @quotation 31 | ;; @c Nobody can give you wiser advice than yourself. 32 | ;; @c @author Marcus Tullius Cicero 33 | ;; @c @end quotation 34 | 35 | ;; @quotation 36 | ;; No enemy is worse than bad advice. 37 | ;; @author Sophocles 38 | ;; @end quotation 39 | 40 | ;; Emacs has a facility to define ``advice'' these are pieces of code 41 | ;; that run before, after, or around an already defined function. This 42 | ;; @url{"http://electricimage.net/cupboard/2013/05/04/on-defadvice/",article} 43 | ;; provides a good example. 44 | 45 | ;;; Code: 46 | 47 | (define-module (emacsy advice) 48 | #:use-module (srfi srfi-9)) 49 | 50 | ;; How will this work? Before we try to make the macro, let's focus on 51 | ;; building up the functions. We want to have a function that we can 52 | ;; substitute for the original function which will have a number of 53 | ;; before, after, and around pieces of advice that can be attached to it. 54 | (define-record-type 55 | (make-record-of-advice original before around after) 56 | record-of-advice? 57 | (original advice-original) 58 | (before advice-before set-advice-before!) 59 | (around advice-around set-advice-around!) 60 | (after advice-after set-advice-after!)) 61 | 62 | ;;. 63 | (define-record-type 64 | (make-piece-of-advice procedure name class priority flag) 65 | piece-of-advice? 66 | (procedure poa-procedure) 67 | (name poa-name) ;; symbol not string 68 | (class poa-class set-poa-class!) 69 | (priority poa-priority set-poa-priority!) 70 | (flag poa-flag set-poa-flag!)) 71 | 72 | (define next-advice-func (make-fluid)) 73 | 74 | (define (make-advising-function advice) 75 | (lambda args 76 | (let ((around-advices (append (advice-around advice) 77 | (list (make-piece-of-advice 78 | (advice-original 79 | advice) 80 | 'original 81 | 'bottom 82 | 0 83 | 'activate)))) 84 | (result #f)) 85 | (define (my-next-advice) 86 | (if (null? around-advices) 87 | (throw 'next-advices-drained) 88 | (let ((next-one-around (car around-advices))) 89 | (set! around-advices (cdr around-advices)) 90 | (apply (poa-procedure next-one-around) args)))) 91 | ;; This could be done more cleanly. For instance, 92 | ;; If one calls (next-advice) more than once, 93 | ;; they drain all the advice rather than calling 94 | ;; the same advice again, which is probably 95 | ;; the more correct behavior. 96 | 97 | (for-each (lambda (before) 98 | (apply (poa-procedure before) args)) 99 | (advice-before advice)) 100 | 101 | (set! result (with-fluid* next-advice-func my-next-advice 102 | (lambda () 103 | (next-advice)))) 104 | (for-each (lambda (after) 105 | (apply (poa-procedure after) result args)) 106 | (advice-after advice)) 107 | result))) 108 | 109 | (define (next-advice) 110 | (if (fluid-bound? next-advice-func) 111 | ((fluid-ref next-advice-func)) 112 | (throw 'no-next-advice-bound))) 113 | -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/cursor-list.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | ;; cursor-list.scm 21 | 22 | ;; This module creates a list with a cursor, that is, a position 23 | ;; within the list. It's represented by two lists. The "left" list is 24 | ;; held in reverse order which has the preceding contents. The "right" 25 | ;; list is held in the conventional order. 26 | 27 | (define-module (emacsy cursor-list) 28 | #:use-module (ice-9 format) 29 | #:use-module (ice-9 optargs) 30 | #:use-module (srfi srfi-1) 31 | #:use-module (srfi srfi-9) 32 | #:use-module (srfi srfi-9 gnu) 33 | #:export (make-cursor-list 34 | cursor-right? 35 | cursor-right! 36 | cursor-left? 37 | cursor-left! 38 | cursor-right-insert! 39 | cursor-left-insert! 40 | cursor-right-delete! 41 | cursor-left-delete! 42 | cursor-right-ref 43 | cursor-right-set! 44 | cursor-left-ref 45 | cursor-left-set! 46 | cursor-list? 47 | cursor-list->list)) 48 | 49 | (define-record-type 50 | (%make-cursor-list left right) 51 | cursor-list? 52 | (left left set-left!) 53 | (right right set-right!)) 54 | 55 | (define* (make-cursor-list list #:optional (index 0)) 56 | (%make-cursor-list (reverse (take list index)) (drop list index))) 57 | 58 | (define (cursor-right-ref clist) 59 | (car (right clist))) 60 | 61 | (define (cursor-left-ref clist) 62 | (car (left clist))) 63 | 64 | (define (cursor-right-set! clist item) 65 | (set-car! (right clist) item) 66 | *unspecified*) 67 | 68 | (define (cursor-left-set! clist item) 69 | (set-car! (left clist) item) 70 | *unspecified*) 71 | 72 | (define* (cursor-right? clist #:optional (count 1)) 73 | (>= (length (right clist)) count)) 74 | 75 | (define* (cursor-left? clist #:optional (count 1)) 76 | (>= (length (left clist)) count)) 77 | 78 | (define (cursor-right! clist) 79 | (when (cursor-right? clist) 80 | (set-left! clist (cons (cursor-right-ref clist) (left clist))) 81 | (set-right! clist (cdr (right clist)))) 82 | *unspecified*) 83 | 84 | (define (cursor-left! clist) 85 | (when (cursor-left? clist) 86 | (set-right! clist (cons (cursor-left-ref clist) (right clist))) 87 | (set-left! clist (cdr (left clist)))) 88 | *unspecified*) 89 | 90 | (define (cursor-right-insert! clist item) 91 | (set-right! clist (cons item (right clist))) 92 | *unspecified*) 93 | 94 | (define (cursor-left-insert! clist item) 95 | (set-left! clist (cons item (left clist))) 96 | *unspecified*) 97 | 98 | (define (cursor-right-delete! clist) 99 | (set-right! clist (cdr (right clist))) 100 | *unspecified*) 101 | 102 | (define (cursor-left-delete! clist) 103 | (set-left! clist (cdr (left clist))) 104 | *unspecified*) 105 | 106 | (define (cursor-list->list clist) 107 | (append (reverse (left clist)) (right clist))) 108 | 109 | (set-record-type-printer! 110 | (lambda (clist port) 111 | (format port "#" 112 | (reverse (left clist)) 113 | (right clist)))) 114 | -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/emacsy.h: -------------------------------------------------------------------------------- 1 | /* 2 | Emacsy --- An embeddable Emacs-like library using GNU Guile 3 | 4 | Copyright (C) 2012, 2013 Shane Celis 5 | Copyright (C) 2019, Jan (janneke) Nieuwenhuizen 6 | 7 | This file is part of Emacsy. 8 | 9 | Emacsy is free software: you can redistribute it and/or modify 10 | it under the terms of the GNU General Public License as published by 11 | the Free Software Foundation, either version 3 of the License, or 12 | (at your option) any later version. 13 | 14 | Emacsy is distributed in the hope that it will be useful, 15 | but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | GNU General Public License for more details. 18 | 19 | You should have received a copy of the GNU General Public License 20 | along with Emacsy. If not, see . 21 | */ 22 | 23 | #ifndef __EMACSY_H 24 | #define __EMACSY_H 1 25 | 26 | #ifdef __cplusplus 27 | extern "C" { 28 | #endif 29 | 30 | #include 31 | 32 | /* Here are the constants for the C API. */ 33 | /* */ 34 | /* */ 35 | /* = */ 36 | #define EMACSY_MODKEY_COUNT 6 37 | 38 | #define EMACSY_MODKEY_ALT 1 // A 39 | #define EMACSY_MODKEY_CONTROL 2 // C 40 | #define EMACSY_MODKEY_HYPER 4 // H 41 | #define EMACSY_MODKEY_META 8 // M 42 | #define EMACSY_MODKEY_SUPER 16 // s 43 | #define EMACSY_MODKEY_SHIFT 32 // S 44 | 45 | #define EMACSY_MOUSE_BUTTON_DOWN 0 46 | #define EMACSY_MOUSE_BUTTON_UP 1 47 | #define EMACSY_MOUSE_MOTION 2 48 | 49 | #define EMACSY_INTERACTIVE 1 50 | #define EMACSY_NON_INTERACTIVE 0 51 | 52 | /* Here are the return flags that may be returned by \verb|emacsy_tick|. */ 53 | /* */ 54 | /* */ 55 | /* = */ 56 | #define EMACSY_QUIT_APPLICATION_P 1 57 | #define EMACSY_ECHO_AREA_UPDATED_P 2 58 | #define EMACSY_MODELINE_UPDATED_P 4 59 | #define EMACSY_RAN_UNDEFINED_COMMAND_P 8 60 | 61 | /* 62 | * Emacsy provides a C API to ease integration with C and C++ 63 | * programs. The C API is given below. 64 | */ 65 | 66 | /* Initialize Emacsy. */ 67 | int emacsy_initialize (int init_flags); 68 | 69 | /* Enqueue a keyboard event. */ 70 | void emacsy_key_event (int char_code, 71 | int modifier_key_flags); 72 | 73 | /* Enqueue a mouse event. */ 74 | void emacsy_mouse_event (int x, int y, 75 | int state, 76 | int button, 77 | int modifier_key_flags); 78 | 79 | /* Run an iteration of Emacsy's event loop, does not block. */ 80 | int emacsy_tick (); 81 | 82 | /* Return the message or echo area. */ 83 | char *emacsy_message_or_echo_area (); 84 | 85 | /* Return the mode line. */ 86 | char *emacsy_mode_line (); 87 | 88 | /* Return the name of the current buffer. */ 89 | char *emacsy_current_buffer (); 90 | 91 | /* Run a hook. */ 92 | int emacsy_run_hook_0 (char const *hook_name); 93 | 94 | /* Return the minibuffer point. */ 95 | int emacsy_minibuffer_point (); 96 | 97 | /* Terminate Emacsy; run termination hook. */ 98 | int emacsy_terminate (); 99 | 100 | /* Attempt to load a module. */ 101 | int emacsy_load_module (char const *module_name); 102 | 103 | /* Load a file in the emacsy environment. */ 104 | //int emacsy_load(const char *file_name); 105 | 106 | /* Convert the modifier_key_flags into a Scheme list of symbols. */ 107 | SCM modifier_key_flags_to_list(int modifier_key_flags); 108 | 109 | /* SCM scm_c_string_to_symbol (char const* str) */ 110 | SCM scm_c_string_to_symbol (char const* str); 111 | 112 | /* Ref @var{name} from emacsy module. */ 113 | SCM scm_c_emacsy_ref (char const* name); 114 | 115 | #ifdef __cplusplus 116 | } 117 | #endif 118 | 119 | #endif // __EMACSY_H 120 | -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/emacsy.pc.in: -------------------------------------------------------------------------------- 1 | prefix=@prefix@ 2 | exec_prefix=@exec_prefix@ 3 | libdir=@libdir@ 4 | includedir=@includedir@ 5 | 6 | Name: Emacsy 7 | Description: An Emacs-like Library for GNU Guile Scheme 8 | URL: https://savannah.nongnu.org/projects/emacsy 9 | Version: @VERSION@ 10 | Requires: guile-@GUILE_EFFECTIVE_VERSION@ 11 | Libs: -L${libdir} -lemacsy 12 | Cflags: -I${includedir} 13 | -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/emacsy.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | (define-module (emacsy emacsy) 21 | #:use-module (emacsy util) 22 | #:use-module (emacsy self-doc) 23 | #:use-module (emacsy event) 24 | #:use-module (emacsy keymap) 25 | #:use-module (emacsy coroutine) 26 | #:use-module (emacsy agenda) 27 | #:use-module (emacsy command) 28 | #:use-module (emacsy mode) 29 | #:use-module (emacsy buffer) 30 | #:use-module (emacsy text) 31 | #:use-module (emacsy block) 32 | #:use-module (emacsy klecl) 33 | #:use-module (emacsy kbd-macro) 34 | #:use-module (emacsy minibuffer) 35 | #:use-module (emacsy core) 36 | #:use-module (emacsy help)) 37 | 38 | ;;; Commentary: 39 | 40 | ;; @node Emacsy Facade 41 | ;; @section Emacsy Facade 42 | 43 | ;; So that users of our library don't have to import all of our nicely 44 | ;; partitioned modules individually, we'll expose a facade module that 45 | ;; re-exports all of the public interfaces for each module. Just use 46 | ;; @example 47 | ;; (use-modules (emacsy emacsy)) 48 | ;; @end example 49 | ;; or 50 | ;; @example 51 | ;; #:use-module (emacsy emacsy) 52 | ;; @end example 53 | 54 | ;;; Code: 55 | 56 | (define (re-export-modules . modules) 57 | (define (re-export-module module) 58 | (module-for-each 59 | (lambda (sym var) 60 | ;;(format #t "re-exporting ~a~%" sym) 61 | (module-re-export! (current-module) (list sym))) 62 | (resolve-interface module))) 63 | (for-each re-export-module modules)) 64 | 65 | (re-export-modules 66 | '(emacsy util) 67 | '(emacsy self-doc) 68 | '(emacsy keymap) 69 | '(emacsy event) 70 | '(emacsy mode) 71 | '(emacsy buffer) 72 | '(emacsy text) 73 | '(emacsy coroutine) 74 | '(emacsy agenda) 75 | '(emacsy command) 76 | '(emacsy block) 77 | '(emacsy klecl) 78 | '(emacsy kbd-macro) 79 | '(emacsy minibuffer) 80 | '(emacsy core) 81 | '(emacsy help)) 82 | -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/help.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | ;;; Commentary: 21 | 22 | ;; @node Help 23 | ;; @section Help 24 | 25 | ;;; Code: 26 | 27 | (define-module (emacsy help) 28 | #:use-module (emacsy self-doc) 29 | #:use-module (emacsy keymap) 30 | #:use-module (emacsy klecl) 31 | #:use-module (emacsy command) 32 | #:use-module (emacsy minibuffer) 33 | #:use-module (emacsy core)) 34 | 35 | ;;. 36 | (define-interactive (describe-variable #:optional symbol) #t) 37 | 38 | (define-interactive 39 | (describe-variable 40 | #:optional 41 | (symbol (completing-read 42 | "Describe variable: " 43 | (emacsy-collect-kind (current-module) 'variable 1) 44 | #:to-string symbol->string))) 45 | ;;(message "Describing variable ~a: ~a" symbol (variable-documentation symbol)) 46 | (message "~a" (variable-documentation symbol))) 47 | 48 | ;;. 49 | (define-interactive (describe-command #:optional symbol) #t) 50 | 51 | (define-interactive 52 | (describe-command 53 | #:optional 54 | (symbol (completing-read 55 | "Describe command: " 56 | (emacsy-collect-kind (current-module) 'command 1) 57 | #:to-string symbol->string))) 58 | ;;(message "Describing variable ~a: ~a" symbol (variable-documentation symbol)) 59 | (message "~a" (procedure-documentation (module-ref (current-module) symbol)))) 60 | ;;; = 61 | 62 | (define-key global-map "C-h v" 'describe-variable) 63 | (define-key global-map "C-h c" 'describe-command) 64 | -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/job.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | (define-module (emacsy job) 21 | #:use-module (srfi srfi-1) 22 | #:use-module (srfi srfi-9) 23 | #:use-module (srfi srfi-9 gnu) 24 | #:use-module (emacsy coroutine) 25 | #:use-module (emacsy agenda) 26 | #:export ( 27 | job? 28 | make-job 29 | get-job-id 30 | suspend-job 31 | continue-job)) 32 | 33 | (define-record-type 34 | (%make-job job-id job-state job-exit-value job-cont) 35 | job? 36 | (job-id job-id) 37 | (job-state job-state set-job-state!) 38 | (job-exit-value job-exit-value set-job-exit-value!) 39 | (job-cont job-cont set-job-cont!)) 40 | 41 | (set-record-type-printer! 42 | (lambda (job port) 43 | (format port "# port))) 53 | 54 | 55 | 56 | (define *current-job-list* '()) 57 | 58 | (define next-job-id 1) 59 | 60 | (define (job-id->job jid) 61 | (find (lambda (job) 62 | (eq? (job-id job) jid)) 63 | *current-job-list*)) 64 | 65 | (define (coerce-to-job job-or-jid) 66 | (if (job? job-or-jid) 67 | job-or-jid 68 | (job-id->job job-or-jid))) 69 | 70 | (define* (make-job thunk) 71 | "Creates a coroutine that has some job control." 72 | (let ((job (%make-job next-job-id 'baby #f #f))) 73 | (define (handler cont key . args) 74 | (define (resume . args) 75 | ;; (format #t "resuming job ~a~%" (job-id job)) 76 | ;; Call continuation that resumes the procedure. 77 | (call-with-prompt 'coroutine-prompt 78 | (lambda () (apply cont args)) 79 | handler)) 80 | (define (job-resume . args) 81 | (if (eq? (job-state job) 'running) 82 | (apply resume args) 83 | (begin 84 | (set-job-cont! job job-resume) 85 | ;; (format #t "job ~a unable to resume because it is ~a~%" 86 | ;; (job-id job) 87 | ;; (job-state job)) 88 | ))) 89 | (case key 90 | ((callback) 91 | (when (procedure? (car args)) 92 | (apply (car args) job-resume (cdr args)))) 93 | ((user-data) 94 | (resume job)))) 95 | (set! next-job-id (1+ next-job-id)) 96 | (set! *current-job-list* (cons job *current-job-list*)) 97 | (values 98 | (lambda () 99 | (if (eq? (job-state job) 'baby) 100 | (begin 101 | (set-job-state! job 'running) 102 | ;;(format #t "starting job ~a~%" (job-id job)) 103 | (call-with-prompt 'coroutine-prompt 104 | (lambda () (job-exit (thunk))) 105 | handler)) 106 | (throw 'job-already-started))) 107 | job))) 108 | 109 | (define (suspend-job job-or-jid) 110 | "Suspend a job that is currently running." 111 | (set-job-state! (coerce-to-job job-or-jid) 'suspended)) 112 | 113 | (define (continue-job job-or-jid) 114 | "Continue a suspended job and schedule it to be run." 115 | (let ((job (coerce-to-job job-or-jid))) 116 | (when (eq? (job-state job) 'suspended) 117 | (set-job-state! job 'running) 118 | (agenda-schedule (job-cont job)) 119 | (set-job-cont! job #f)))) 120 | 121 | (define (wait-for-job job-or-jid) 122 | "Waits for a job to complete." 123 | ;; XXX This should be smarter than polling. 124 | (let ((job (coerce-to-job job-or-jid))) 125 | (while (not (eq? (job-state job) 'zombie)) 126 | (wait)) 127 | (job-exit-value job))) 128 | 129 | (define (job-exit return-value) 130 | "Exit the job with the given return-value." 131 | (let ((job (couser-data))) 132 | (set-job-state! job 'zombie) 133 | (set-job-exit-value! job return-value)) 134 | (yield (lambda (resume) 135 | return-value))) 136 | 137 | (define (get-job-id) 138 | "Returns the job-id within the job." 139 | (job-id (couser-data))) 140 | -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/kbd-macro.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | ;;; Commentary: 21 | 22 | ;; @node Kbd-Macro 23 | ;; @section Kbd-Macro 24 | 25 | ;; @quotation 26 | ;; @dots{} 27 | ;; @author @dots{} 28 | ;; @end quotation 29 | 30 | ;; We will now add a keyboard macro facility familiar to Emacs users. We 31 | ;; hook into the [[read-event]] procedure using a hook. 32 | 33 | ;;; Code: 34 | 35 | (define-module (emacsy kbd-macro) 36 | #:use-module (ice-9 q) 37 | #:use-module (srfi srfi-1) 38 | #:use-module (emacsy util) 39 | #:use-module (emacsy event) 40 | #:use-module (emacsy command) 41 | #:use-module (emacsy keymap) 42 | #:use-module (emacsy klecl) 43 | #:use-module (emacsy block)) 44 | 45 | ;;. 46 | (define-public defining-kbd-macro? #f) 47 | 48 | ;;. 49 | (define-public last-kbd-macro '()) 50 | 51 | ;;. 52 | (define-public executing-kbd-macro? #f) 53 | 54 | ;;. 55 | (define-public kbd-macro-termination-hook (make-hook)) 56 | 57 | ;;. 58 | (define-public executing-temporal-kbd-macro-hook (make-hook 1)) 59 | 60 | ;; XXX This also may record the key event that stops the keyboard 61 | ;; macro, which it shouldn't. 62 | (define (kbd-read-event-hook event) 63 | (when defining-kbd-macro? 64 | (message "RECORDING ~a" event) 65 | (cons! event last-kbd-macro))) 66 | 67 | ;;. 68 | (define-interactive (kmacro-start-macro) 69 | (set! last-kbd-macro '()) 70 | (set! defining-kbd-macro? #t)) 71 | 72 | ;;. 73 | (define-interactive (kmacro-end-macro) 74 | (set! defining-kbd-macro? #f)) 75 | 76 | ;;. 77 | (define-interactive (kmacro-end-and-call-macro) 78 | (if defining-kbd-macro? 79 | (kmacro-end-macro)) 80 | (execute-kbd-macro last-kbd-macro)) 81 | 82 | ;; FIXME 83 | ;;. 84 | (define-interactive (execute-kbd-macro #:optional (kbd-macro last-kbd-macro) (count 1) loopfunc) #t) 85 | 86 | (define-interactive 87 | (execute-kbd-macro #:optional 88 | (kbd-macro last-kbd-macro) 89 | (count 1) (loopfunc #f)) 90 | (let ((orig-event-queue event-queue) 91 | (new-event-queue (make-q))) 92 | (for-each (lambda (x) 93 | (enq! new-event-queue x)) 94 | (reverse kbd-macro)) 95 | (in-out-guard 96 | (lambda () 97 | (set! event-queue new-event-queue) 98 | (set! executing-kbd-macro? #t)) 99 | (lambda () 100 | (command-loop (lambda args (not (q-empty? event-queue))))) 101 | ;; Turn off the executing-kbd-macro?. 102 | (lambda () 103 | (set! executing-kbd-macro? #f) 104 | (set! event-queue orig-event-queue) 105 | (run-hook kbd-macro-termination-hook))))) 106 | 107 | ;; In addition to regular keyboard macros, Emacsy can execute keyboard 108 | ;; macros such that they reproduce the keys at the same pace as they were 109 | ;; recorded. 110 | (define-interactive (execute-temporal-kbd-macro #:optional (kbd-macro last-kbd-macro)) 111 | (in-out 112 | (set! executing-kbd-macro? #t) 113 | (let* ((start-time (emacsy-time)) 114 | (macro-start-time (time (last kbd-macro)))) 115 | (let loop ((macro (reverse kbd-macro))) 116 | (when (not (null? macro)) 117 | (block-until (lambda () 118 | (let ((duration (- (emacsy-time) start-time) )) 119 | (run-hook executing-temporal-kbd-macro-hook duration) 120 | (>= duration 121 | (- (time (car macro)) macro-start-time))))) 122 | (emacsy-event (car macro)) 123 | (loop (cdr macro))))) 124 | (begin 125 | (set! executing-kbd-macro? #f) 126 | (run-hook kbd-macro-termination-hook)))) 127 | 128 | ;;; How do I ensure this only happens once? 129 | (add-hook! read-event-hook kbd-read-event-hook) 130 | -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/line-pragma.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | (define-module (emacsy line-pragma) 20 | #:use-module (ice-9 rdelim)) 21 | 22 | (eval-when (compile load eval) 23 | (define line-pragma-handler ;;; BUG: The line pragma ends up littering the source with zero length 24 | ;;; strings, which often doesn't matter, but it can't be used everywhere 25 | ;;; especially within a particular form. I'm not entirely sure how to fix 26 | ;;; that. 27 | ;;; 28 | ;;; 29 | ;;; = 30 | (lambda (char port) 31 | (let ((ine (read port)) 32 | (lineno (read port)) 33 | (filename (read port))) 34 | (if (not (eq? ine 'ine)) 35 | (error (format #f "Expected '#line '; got '#~a~a ~a \"~a\"'." char ine lineno filename))) 36 | (set-port-filename! port filename) 37 | (set-port-line! port lineno) 38 | (set-port-column! port 0) 39 | ;; Return unspecified on purpose. 40 | *unspecified* 41 | ))) 42 | (read-hash-extend #\l #f) 43 | (read-hash-extend #\l line-pragma-handler) 44 | #;(read-hash-extend #\" ;;; The above code will see a string "\#line 352 " followed by a bare 45 | ;;; symbol emacsy.w, which will not do. To get around this, I implemented 46 | ;;; another reader extension that will strip out any \#l lines within it. 47 | ;;; 48 | ;;; 49 | ;;; = 50 | (lambda (char port) 51 | (let ((accum '())) 52 | (let loop ((entry (read-char port))) 53 | (if (or (eof-object? entry) 54 | (and (char=? #\" entry) 55 | (char=? #\# (peek-char port)) 56 | (begin (read-char port) 57 | #t))) 58 | ;; We're done 59 | (apply string (reverse accum)) 60 | (begin 61 | (if (and (char=? #\# entry) 62 | (char=? #\l (peek-char port))) 63 | ;; Drop this line 64 | (begin (read-line port) 65 | (loop (read-char port))) 66 | (begin 67 | ;; Keep and loop 68 | (set! accum (cons entry accum)) 69 | (loop (read-char port))))))))))) 70 | -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/mode.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | (define-module (emacsy mode) 20 | #:use-module (ice-9 optargs) 21 | #:use-module (srfi srfi-26) 22 | #:use-module (string completion) 23 | #:use-module (oop goops) 24 | #:use-module (emacsy util) 25 | #:use-module (emacsy self-doc) 26 | #:use-module (emacsy event) 27 | #:use-module (emacsy keymap) 28 | #:use-module (emacsy command) 29 | #:use-module (emacsy klecl) 30 | #:use-module (rnrs base) 31 | #:export ( 32 | mode-name 33 | mode-map)) 34 | 35 | (define-class () 36 | (name #:getter mode-name #:init-keyword #:mode-name) 37 | (mode-map #:accessor mode-map 38 | #:init-keyword #:mode-map 39 | #:init-form (make-keymap))) 40 | -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/mru-stack.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | ;;; Commentary: 21 | 22 | ;; @node Mru-stack 23 | ;; @subsection Mru-stack 24 | 25 | ;; The buffers are kept in a most recently used stack that has the 26 | ;; following operators: add!, remove!, contains?, recall!, and list. 27 | 28 | ;;; Code: 29 | 30 | (define-module (emacsy mru-stack) 31 | #:use-module (ice-9 q) 32 | #:use-module (srfi srfi-1) 33 | #:use-module (oop goops) 34 | #:use-module (emacsy util) 35 | #:export ( 36 | mru-add! 37 | mru-remove! 38 | mru-recall! 39 | mru-set! 40 | mru-ref 41 | mru-empty? 42 | mru-contains? 43 | mru-next! 44 | mru-prev! 45 | mru-list)) 46 | 47 | ;;. 48 | (define-class () 49 | (queue #:accessor q #:init-thunk (lambda () (make-q))) 50 | (index #:accessor index #:init-value 0)) 51 | 52 | (define-method (write (obj ) port) 53 | ; (write (string-concatenate (list "#")) port) 54 | (format port "" (mru-list obj))) 55 | 56 | ;;. 57 | (define-method (mru-add! (s ) x) 58 | (q-push! (q s) x)) 59 | 60 | ;;. 61 | (define-method (mru-remove! (s ) x) 62 | (when (and (mru-contains? s x) 63 | (equal? 1 (length (mru-list s)))) 64 | (begin (set! (index s) 0))) 65 | (let ((orig-x (mru-ref s))) 66 | (q-remove! (q s) x) 67 | (unless (eq? orig-x x) 68 | (mru-set! s orig-x)))) 69 | 70 | ;;. 71 | (define-method (mru-recall! (s ) x) 72 | (q-remove! (q s) x) 73 | (q-push! (q s) x) 74 | (set! (index s) 0) 75 | (mru-list s)) 76 | 77 | ;;. 78 | (define-method (mru-set! (s ) x) 79 | ;; Should this add the buffer if it's not already there? No. 80 | (if (mru-empty? s) 81 | #f 82 | (let ((i (list-index (lambda (e) 83 | (eq? x e)) 84 | (mru-list s)))) 85 | (if i 86 | (begin (set! (index s) i) 87 | #t) 88 | (begin (mru-next! s) 89 | #f))))) 90 | 91 | ;;. 92 | (define-method (mru-ref (s )) 93 | (and (not (mru-empty? s)) 94 | (list-ref (mru-list s) 95 | (index s)))) 96 | 97 | ;;. 98 | (define-method (mru-list (s )) 99 | (car (q s))) 100 | 101 | ;;. 102 | (define-method (mru-empty? (s )) 103 | (q-empty? (q s))) 104 | 105 | ;;. 106 | (define-method (mru-contains? (s ) x) 107 | (memq x (mru-list s))) 108 | 109 | ;; The order of the elements may not change yet the index may be moved 110 | ;; around. 111 | (define-method (mru-next! (s ) count) 112 | (when (not (mru-empty? s)) 113 | (set! (index s) 114 | (modulo (+ (index s) count) 115 | (length (mru-list s)))) 116 | (mru-ref s))) 117 | 118 | ;;. 119 | (define-method (mru-prev! (s ) count) 120 | (mru-next! s (- count))) 121 | 122 | ;;. 123 | (define-method (mru-prev! (s )) 124 | (mru-prev! s 1)) 125 | 126 | ;;. 127 | (define-method (mru-next! (s )) 128 | (mru-next! s 1)) 129 | -------------------------------------------------------------------------------- /3rdparty/emacsy/emacsy/vector-math.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | ;;; = 20 | (define-module (emacsy vector-math) 21 | #:export (make-identity-matrix 22 | matrix.)) 23 | 24 | (define (make-identity-matrix dimension) 25 | (case dimension 26 | ((1) #(1)) 27 | ((2) #(1 0 0 1)) 28 | ((3) #(1 0 0 0 1 0 0 0 1)))) 29 | 30 | (define (matrix. a b) 31 | a) 32 | 33 | ;;; @ @enumerate 34 | ;;; @item vector-component-usage 35 | 36 | ;;; The component of $\bv a$ in the $\bv b$ direction. 37 | ;;; @align* 38 | ;;; \comp_\bv b \bv a &= \bv a \cdot \bhv b \\ 39 | ;;; &= \frac{\bv a \cdot \bv b}{||\bv b||} 40 | ;;; @end align* 41 | 42 | ;;; <>= 43 | (define (vector-component a b) 44 | ;(string-trim-both 45 | ;; #" <> "# 46 | ;char-set:whitespace) 47 | (/ (vector-dot a b) (vector-norm b))) 48 | ;; @ Tried to define vector-component-usage to "Scalar projection" 49 | 50 | ;; @item Vector projection 51 | 52 | ;; The vector projection of $\bv a$ on $\bv b$. 53 | ;; @align* 54 | ;; \proj_\bv b \bv a &= a_1 \bhv b \\ 55 | ;; a_1 &= \comp_\bv b \bv a 56 | ;; @end align* 57 | 58 | ;; <>= 59 | (define (vector-projection a b) 60 | (vector* (vector-component a b) (vector-normalize b))) 61 | ;; @ @end enumerate 62 | -------------------------------------------------------------------------------- /3rdparty/emacsy/example/emacsy-webkit-gtk-w-buffers.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | ;; Here's where the fun begins. 21 | (use-modules (oop goops) 22 | (srfi srfi-1) ;;any 23 | ) 24 | 25 | (define-interactive (new-tab #:optional 26 | (url (read-from-minibuffer "URL: "))) 27 | (define (on-enter) 28 | (when (local-var 'web-view) 29 | (format #t "Setting web-view to ~a~%" (local-var 'web-view)) 30 | (set-web-view! (local-var 'web-view)))) 31 | (define (on-kill) 32 | (when (local-var 'web-view) 33 | (format #t "Destroying web-view ~a~%" (local-var 'web-view)) 34 | (destroy-web-view! (local-var 'web-view)))) 35 | (let ((buffer (switch-to-buffer url))) 36 | (set! (local-var 'web-view) (make-web-view)) 37 | (add-hook! (buffer-enter-hook buffer) 38 | on-enter) 39 | (add-hook! (buffer-kill-hook buffer) 40 | on-kill) 41 | (on-enter) 42 | (load-url url))) 43 | 44 | (define-interactive 45 | (load-url #:optional 46 | (url (read-from-minibuffer "URL: "))) 47 | (webkit-load-url url)) 48 | 49 | ;; Load-url is all right, but it requires an actual URL. 50 | ;; Let's fix that with a new command: GOTO. 51 | (define-interactive 52 | (goto #:optional 53 | (urlish (read-from-minibuffer "GOTO: "))) 54 | (set-buffer-name! urlish) 55 | (cond 56 | ((string-prefix? "http://" urlish) 57 | (load-url urlish)) 58 | ((string-contains urlish " ") 59 | ;; It contains spaces. It's probably a search. 60 | (load-url 61 | (format #f "http://www.google.com/search?q=~a" 62 | (string-map (lambda (c) (if (eq? c #\space) #\+ c)) urlish))) 63 | ) 64 | (else 65 | ;; It's just one word. Let's try adding a .com and http:// if it 66 | ;; needs it. 67 | (load-url (format #f "http://~a~a" urlish 68 | (if (any (lambda (suffix) 69 | (string-suffix? suffix urlish)) 70 | '(".com" ".org" ".net")) 71 | "" 72 | ".com")))))) 73 | 74 | (define-interactive (go-forward) 75 | (webkit-forward)) 76 | 77 | (define-interactive (go-back) 78 | (webkit-backward)) 79 | 80 | (define-interactive (reload) 81 | (webkit-reload)) 82 | 83 | (define-interactive (reload-script) 84 | (load ".emacsy-webkit-gtk.scm")) 85 | 86 | (define find-text #f) 87 | 88 | ;; These aren't as good as Emacs' isearch-forward, but they're not 89 | ;; a bad start. 90 | (define-interactive 91 | (search-forward #:optional 92 | (text (or find-text (read-from-minibuffer "Search: ")))) 93 | (set! find-text text) 94 | (webkit-find-next text)) 95 | 96 | (define-interactive 97 | (search-backward #:optional 98 | (text (or find-text (read-from-minibuffer "Search: ")))) 99 | (set! find-text text) 100 | (webkit-find-previous text)) 101 | 102 | ;; Now let's bind these to some keys. 103 | 104 | (define-key global-map (kbd "M-g") 'goto) 105 | (define-key global-map (kbd "s-g") 'goto) 106 | ;; Let's use the super key to go forward and backward. 107 | (define-key global-map (kbd "s-f") 'go-forward) 108 | (define-key global-map (kbd "s-b") 'go-back) 109 | (define-key global-map (kbd "C-s") 'search-forward) 110 | (define-key global-map (kbd "C-r") 'search-backward) 111 | (define-key global-map (kbd "C-b") 'next-buffer) 112 | (define-key global-map (kbd "C-x k") 'kill-buffer) 113 | -------------------------------------------------------------------------------- /3rdparty/emacsy/example/emacsy-webkit-gtk.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | ;; We generate the file @file{example/hello-emacsy.c.x} by running the 21 | ;; command: @code{guile-snarf example/hello-emacsy.c}. Emacsy can now 22 | ;; access and alter the application's internal state. 23 | ;;. 24 | 25 | ;; Here's where the fun begins. 26 | (use-modules (srfi srfi-1) ;; any 27 | ) 28 | 29 | (define-interactive 30 | (load-url #:optional 31 | (url (read-from-minibuffer "URL: "))) 32 | (webkit-load-url url)) 33 | 34 | ;; Load-url is all right, but it requires an actual URL. 35 | ;; Let's fix that with a new command: GOTO. 36 | (define-interactive 37 | (goto #:optional 38 | (urlish (read-from-minibuffer "GOTO: "))) 39 | (cond 40 | ((string-prefix? "http://" urlish) 41 | (load-url urlish)) 42 | ((string-contains urlish " ") 43 | ;; It contains spaces. It's probably a search. 44 | (load-url 45 | (format #f "http://www.google.com/search?q=~a" 46 | (string-map (lambda (c) (if (eq? c #\space) #\+ c)) urlish))) 47 | ) 48 | (else 49 | ;; It's just one word. Let's try adding a .com and http:// if it 50 | ;; needs it. 51 | (load-url (format #f "http://~a~a" urlish 52 | (if (any (lambda (suffix) 53 | (string-suffix? suffix urlish)) 54 | '(".com" ".org" ".net")) 55 | "" 56 | 57 | ".com")))))) 58 | 59 | (define-interactive (go-forward) 60 | (webkit-forward)) 61 | 62 | (define-interactive (go-back) 63 | (webkit-backward)) 64 | 65 | (define-interactive (reload) 66 | (webkit-reload)) 67 | 68 | (define-interactive (reload-script) 69 | (load ".emacsy-webkit-gtk.scm")) 70 | 71 | (define find-text #f) 72 | 73 | ;; These aren't as good as Emacs' isearch-forward, but they're not 74 | ;; a bad start. 75 | (define-interactive 76 | (search-forward #:optional 77 | (text (or find-text (read-from-minibuffer "Search: ")))) 78 | (set! find-text text) 79 | (webkit-find-next text)) 80 | 81 | (define-interactive 82 | (search-backward #:optional 83 | (text (or find-text (read-from-minibuffer "Search: ")))) 84 | (set! find-text text) 85 | (webkit-find-previous text)) 86 | 87 | ;; Now let's bind these to some keys. 88 | 89 | (define-key global-map (kbd "M-g") 'goto) 90 | (define-key global-map (kbd "s-g") 'goto) 91 | ;; Let's use the super key to go forward and backward. 92 | (define-key global-map (kbd "s-f") 'go-forward) 93 | (define-key global-map (kbd "s-b") 'go-back) 94 | (define-key global-map (kbd "C-s") 'search-forward) 95 | (define-key global-map (kbd "C-r") 'search-backward) 96 | -------------------------------------------------------------------------------- /3rdparty/emacsy/example/hello-emacsy.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | ;; We generate the file @file{example/hello-emacsy.c.x} by running the 21 | ;; command: @code{guile-snarf example/hello-emacsy.c}. Emacsy can now 22 | ;; access and alter the application's internal state. 23 | ;;. 24 | 25 | ;; @subsection Changing the UI Now let's use these new procedures to 26 | ;; create interactive commands and bind them to keys by changing our 27 | ;; config file @file{example/hello-emacsy.scm}. 28 | (use-modules (emacsy emacsy)) 29 | 30 | ;;. 31 | (define-interactive (incr-counter #:optional (n (universal-argument-pop!))) 32 | "Increment the counter." 33 | (set-counter! (+ (get-counter) n))) 34 | 35 | ;;. 36 | (define-interactive (decr-counter #:optional (n (universal-argument-pop!))) 37 | "Decrement the counter." 38 | (set-counter! (- (get-counter) n))) 39 | 40 | ;; Bind @var{inc-counter} to @code{=}. 41 | (define-key global-map "=" 'incr-counter) 42 | ;; Bind @var{inc-counter} to @code{-}. 43 | (define-key global-map "-" 'decr-counter) 44 | 45 | ;; We can now hit @verb{|-|} and @verb{|=|} to decrement and increment the 46 | ;; @var{counter}. This is fine, but what else can we do with it? We could 47 | ;; make a macro that increments 5 times by hitting 48 | ;; @verb{|C-x ( = = = = = C-x )|}, then hit @verb{|C-e|} to run that macro. 49 | ;; (set! debug-on-error? #t) 50 | 51 | ;; Let's implement another command that will ask the user for a number to 52 | ;; set the counter to. 53 | ;;. 54 | 55 | ;; Now we can hit @verb{|M-x change-counter|} and we'll be prompted for 56 | ;; the new value we want. There we have it. We have made the simplest 57 | ;; application ever more @emph{Emacs-y}. 58 | (define-interactive (change-counter) 59 | "Change the counter to a new value." 60 | (set-counter! 61 | (string->number 62 | (read-from-minibuffer 63 | "New counter value: ")))) 64 | 65 | ;; @subsection Changing it at Runtime 66 | ;; 67 | ;; We can add commands easily by changing and reloading the file. But 68 | ;; we can do better. Let's start a REPL we can connect to. 69 | ;; @file{example/hello-emacsy.scm}. 70 | ;;. 71 | 72 | ;; @example 73 | ;; (use-modules (system repl server)) 74 | ;; (spawn-server) 75 | ;; @end example 76 | ;; Start a server on port 37146. 77 | ;;. 78 | 79 | ;; Start a server on port 37146. 80 | (use-modules (system repl server)) 81 | (spawn-server) 82 | -------------------------------------------------------------------------------- /3rdparty/emacsy/guix.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile. 2 | ;;; Copyright (C) 2019 Jan Nieuwenhuizen 3 | ;;; Copyright (C) 2019 by Amar Singh 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; This program is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; This program is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with this program. If not, see . 19 | 20 | ;;; Commentary: 21 | ;; 22 | ;; GNU Guix development package. To build and play, run: 23 | ;; 24 | ;; guix environment --ad-hoc -l guix.scm guile 25 | ;; 26 | ;; To build and install, run: 27 | ;; 28 | ;; guix package -f guix.scm 29 | ;; 30 | ;; To build it, but not install it, run: 31 | ;; 32 | ;; guix build -f guix.scm 33 | ;; 34 | ;; To use as the basis for a development environment, run: 35 | ;; 36 | ;; guix environment -l guix.scm 37 | ;; 38 | ;;; Code: 39 | 40 | (use-modules ((guix licenses) #:prefix license:) 41 | (guix build-system gnu) 42 | (guix build-system glib-or-gtk) 43 | (guix gexp) 44 | (guix download) 45 | (guix git-download) 46 | (guix packages) 47 | (gnu packages) 48 | (gnu packages autotools) 49 | (gnu packages compression) 50 | (gnu packages glib) 51 | (gnu packages gettext) 52 | (gnu packages gl) 53 | (gnu packages gnome) 54 | (gnu packages guile) 55 | (gnu packages guile-xyz) 56 | (gnu packages perl) 57 | (gnu packages pkg-config) 58 | (gnu packages texinfo) 59 | (gnu packages tex) 60 | (gnu packages webkit)) 61 | 62 | (define %source-dir (dirname (current-filename))) 63 | 64 | (define-public emacsy 65 | (package 66 | (name "emacsy") 67 | (version "git") 68 | (source (local-file %source-dir 69 | #:recursive? #t 70 | #:select? (git-predicate %source-dir))) 71 | (build-system glib-or-gtk-build-system) 72 | (native-inputs 73 | `(("autoconf" ,autoconf) 74 | ("automake" ,automake) 75 | ("bzip2" ,bzip2) 76 | ("guile" ,guile-2.2) 77 | ("gettext" ,gnu-gettext) 78 | ("libtool" ,libtool) 79 | ("perl" ,perl) 80 | ("pkg-config" ,pkg-config) 81 | ("texinfo" ,texinfo) 82 | ("texlive" ,(texlive-union (list texlive-generic-epsf))))) 83 | (inputs 84 | `(("dbus-glib" ,dbus-glib) 85 | ("guile" ,guile-2.2) 86 | ("guile-lib" ,guile-lib) 87 | ("guile-readline" ,guile-readline) 88 | ("freeglut" ,freeglut) 89 | ("glib-networking" ,glib-networking) 90 | ("gssettings-desktop-schemas" 91 | ,gsettings-desktop-schemas) 92 | ("webkitgtk" ,webkitgtk))) 93 | (arguments 94 | `(#:tests? #t 95 | #:modules ((guix build gnu-build-system) 96 | (guix build glib-or-gtk-build-system) 97 | (guix build utils) 98 | (ice-9 popen) 99 | (ice-9 rdelim) 100 | (ice-9 regex) 101 | (ice-9 ftw) 102 | (srfi srfi-26)) 103 | #:phases 104 | (modify-phases %standard-phases 105 | (add-before 'configure 'setenv 106 | (lambda _ 107 | (setenv "GUILE_AUTO_COMPILE" "0") 108 | #t)) 109 | (add-after 'install 'wrap-binaries 110 | (lambda* (#:key inputs outputs #:allow-other-keys) 111 | (let* ((out (assoc-ref outputs "out")) 112 | (effective (read-line 113 | (open-pipe* OPEN_READ 114 | "guile" "-c" 115 | "(display (effective-version))"))) 116 | (deps (map (cut assoc-ref inputs <>) '("guile-lib" "guile-readline"))) 117 | (scm-path (map (cut string-append <> "/share/guile/site/" effective) `(,out ,@deps))) 118 | (go-path (map (cut string-append <> "/lib/guile/" effective "/site-ccache/") `(,out ,@deps))) 119 | (examples (filter (cut string-match "emacsy" <>) 120 | (scandir (string-append out "/bin/")))) 121 | (progs (map (cut string-append out "/bin/" <>) 122 | examples))) 123 | (map (cut wrap-program <> 124 | `("GUILE_LOAD_PATH" ":" prefix ,scm-path) 125 | `("GUILE_LOAD_COMPILED_PATH" ":" prefix ,go-path)) progs) 126 | #t)))))) 127 | (home-page "https://savannah.nongnu.org/projects/emacsy") 128 | (synopsis "Embeddable GNU Emacs-like library using Guile") 129 | (description 130 | "Emacsy is an embeddable Emacs-like library that uses GNU Guile 131 | as extension language. Emacsy can give a C program an Emacsy feel with 132 | keymaps, minibuffer, recordable macros, history, tab completion, major 133 | and minor modes, etc., and can also be used as a pure Guile library. It 134 | comes with a simple counter example using FreeGLUT and browser examples 135 | in C using Gtk+-3 and WebKitGtk.") 136 | (license license:gpl3+))) 137 | 138 | emacsy 139 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/advice.scm: -------------------------------------------------------------------------------- 1 | ;;; = 2 | ;;; @subsection Legal Stuff 3 | ;;; 4 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 5 | ;;; 6 | ;;; Copyright (C) 2012, 2013 Shane Celis 7 | ;;; 8 | ;;; This file is part of Emacsy. 9 | ;;; 10 | ;;; Emacsy is free software: you can redistribute it and/or modify 11 | ;;; it under the terms of the GNU General Public License as published by 12 | ;;; the Free Software Foundation, either version 3 of the License, or 13 | ;;; (at your option) any later version. 14 | ;;; 15 | ;;; Emacsy is distributed in the hope that it will be useful, 16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;;; GNU General Public License for more details. 19 | ;;; 20 | ;;; You should have received a copy of the GNU General Public License 21 | ;;; along with Emacsy. If not, see . 22 | (use-modules (emacsy advice) 23 | (emacsy event) 24 | (emacsy klecl) 25 | (oop goops) 26 | (srfi srfi-11)) 27 | 28 | (eval-when (compile load eval) 29 | ;; Some trickery so we can test private procedures. 30 | (module-use! (current-module) (resolve-module '(emacsy advice)))) 31 | 32 | ;;; <+ Test Preamble>= 33 | (use-modules (check)) 34 | (use-modules (ice-9 pretty-print)) 35 | (define test-errors '()) 36 | ;;; To test this functionality, we're going to make some counter 37 | ;;; procedures. 38 | ;;; 39 | ;;; 40 | ;;; = 41 | (define (my-orig-func x) 42 | (+ x 1)) 43 | 44 | (define (make-counter) 45 | (let ((x 0)) 46 | (lambda args 47 | (if (and (= (length args) 1) (eq? (car args) 'count)) 48 | x 49 | (begin (set! x (+ x 1)) 50 | (car args)))))) 51 | 52 | (define a-before (make-counter)) 53 | ;;; Let's make an identity advice procedure. It does nothing, but it does 54 | ;;; wrap around the function. 55 | ;;; 56 | ;;; = 57 | (define advice (make-record-of-advice my-orig-func '() '() '())) 58 | 59 | (define advised-func (make-advising-function advice)) 60 | (check (a-before 'count) => 0) 61 | (check (my-orig-func 1) => 2) 62 | (check (advised-func 1) => 2) 63 | (check (a-before 'count) => 0) 64 | ;;; Let's test this with the simple functionality of having a piece of 65 | ;;; before advice. 66 | ;;; 67 | ;;; 68 | ;;; = 69 | (define advice (make-record-of-advice my-orig-func (list (make-piece-of-advice a-before 'a-before 'before 0 'activate)) '() '())) 70 | 71 | (define advised-func (make-advising-function advice)) 72 | (check (a-before 'count) => 0) 73 | (check (my-orig-func 1) => 2) 74 | (check (advised-func 1) => 2) 75 | (check (a-before 'count) => 1) 76 | ;;; Let's check the after advice. 77 | ;;; 78 | ;;; = 79 | (define a-after (make-counter)) 80 | (define advice (make-record-of-advice my-orig-func '() '() 81 | (list (make-piece-of-advice a-after 'a-after 'after 0 'activate)))) 82 | 83 | (define advised-func (make-advising-function advice)) 84 | (check (a-after 'count) => 0) 85 | (check (my-orig-func 1) => 2) 86 | (check (advised-func 1) => 2) 87 | (check (a-after 'count) => 1) 88 | ;;; Let's check the after advice. 89 | ;;; 90 | ;;; = 91 | (define a-around (lambda args 92 | (next-advice) 93 | 1)) 94 | (define advice (make-record-of-advice my-orig-func '() (list (make-piece-of-advice a-around 'a-around 'around 0 'activate)) '())) 95 | 96 | (define advised-func (make-advising-function advice)) 97 | (check (my-orig-func 1) => 2) 98 | (check (advised-func 1) => 1) 99 | ;;; <+ Test Postscript>= 100 | ;(run-tests) 101 | (check-report) 102 | '(if (> (length test-errors) 0) 103 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 104 | (format #t "NO ERRORs in tests.")) 105 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 106 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/buffer.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; Copyright (C) 2019 Jan (janneke) Nieuwenhuizen 5 | ;;; 6 | ;;; This file is part of Emacsy. 7 | ;;; 8 | ;;; Emacsy is free software: you can redistribute it and/or modify 9 | ;;; it under the terms of the GNU General Public License as published by 10 | ;;; the Free Software Foundation, either version 3 of the License, or 11 | ;;; (at your option) any later version. 12 | ;;; 13 | ;;; Emacsy is distributed in the hope that it will be useful, 14 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;;; GNU General Public License for more details. 17 | ;;; 18 | ;;; You should have received a copy of the GNU General Public License 19 | ;;; along with Emacsy. If not, see . 20 | (use-modules (check) 21 | (emacsy mru-stack) 22 | (emacsy buffer) 23 | (emacsy command) 24 | (emacsy event) 25 | (emacsy keymap) 26 | (oop goops) 27 | (rnrs base)) 28 | 29 | (use-private-modules (emacsy buffer)) 30 | 31 | ;;; <+ Test Preamble>= 32 | (use-modules (check)) 33 | (use-modules (ice-9 pretty-print)) 34 | (define test-errors '()) 35 | ;;; = 36 | (define b (make #:name "*test-buffer*")) 37 | (check (buffer-name b) => "*test-buffer*") 38 | (check (object->string b) => "\"#\"") 39 | (check (current-buffer) => #f) 40 | ;;; = 41 | (add-buffer! b) 42 | (check (buffer-name) => "*test-buffer*") 43 | (remove-buffer! b) 44 | (check (current-buffer) => #f) 45 | 46 | (add-buffer! b) 47 | (warn 'buffer-list (buffer-list)) 48 | (define a (make #:name "*a*")) 49 | (add-buffer! a) 50 | (check (current-buffer) => a) 51 | (switch-to-buffer b) 52 | (check (current-buffer) => b) 53 | (switch-to-buffer a) 54 | (check (current-buffer) => a) 55 | 56 | ;;; <+ Test Postscript>= 57 | ;(run-tests) 58 | (check-report) 59 | '(if (> (length test-errors) 0) 60 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 61 | (format #t "NO ERRORs in tests.")) 62 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 63 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/command.scm: -------------------------------------------------------------------------------- 1 | ;;; Layout for tests. 2 | ;;; 3 | ;;; = 4 | ;;; @subsection Legal Stuff 5 | ;;; 6 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 7 | ;;; 8 | ;;; Copyright (C) 2012, 2013 Shane Celis 9 | ;;; 10 | ;;; This file is part of Emacsy. 11 | ;;; 12 | ;;; Emacsy is free software: you can redistribute it and/or modify 13 | ;;; it under the terms of the GNU General Public License as published by 14 | ;;; the Free Software Foundation, either version 3 of the License, or 15 | ;;; (at your option) any later version. 16 | ;;; 17 | ;;; Emacsy is distributed in the hope that it will be useful, 18 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;;; GNU General Public License for more details. 21 | ;;; 22 | ;;; You should have received a copy of the GNU General Public License 23 | ;;; along with Emacsy. If not, see . 24 | (use-modules (emacsy command) 25 | (emacsy event) 26 | (oop goops)) 27 | 28 | (eval-when (compile load eval) 29 | ;; Some trickery so we can test private procedures. 30 | (module-use! (current-module) (resolve-module '(emacsy command)))) 31 | 32 | ;;; <+ Test Preamble>= 33 | (use-modules (check)) 34 | (use-modules (ice-9 pretty-print)) 35 | (define test-errors '()) 36 | ;;; = 37 | (define test-cmd (lambda-cmd args 1)) 38 | (define (test-cmd-2) 2) 39 | (define-cmd (test-cmd-3) 3) 40 | (check (procedure-documentation test-cmd-3) => #f) 41 | (check (test-cmd) => 1) 42 | (check-true (command? test-cmd)) 43 | (check-true (command? test-cmd-2)) 44 | (check-true (command? test-cmd-3)) 45 | (check (assq-ref (procedure-properties test-cmd) 'command-name) => #f) 46 | (check (assq 'command-name (procedure-properties test-cmd-2)) => #f) 47 | (check (command-name test-cmd) => 'proc) 48 | (check (command-name test-cmd-2) => 'test-cmd-2) 49 | (check (command-name test-cmd-3) => 'test-cmd-3) 50 | ;;; = 51 | (define-cmd (test-who-am-i?) 52 | "test-who-am-i? documentation" 53 | (let ((w (what-command-am-i?))) 54 | 1 55 | w)) 56 | (check (command-name test-who-am-i?) => 'test-who-am-i?) 57 | (check (test-who-am-i?) => 'test-who-am-i?) 58 | (check (procedure-documentation test-who-am-i?) => "test-who-am-i? documentation") 59 | ;;; = 60 | (define-cmd (foo) 61 | (if (called-interactively?) 62 | 'interactive 63 | 'non-interactive)) 64 | (check (command? 'foo) => #f) 65 | (check (command? foo) => #t) 66 | (check (command-name foo) => 'foo) 67 | (check-true (command->proc foo)) 68 | 69 | (check-throw (command-execute 'foo) => 'misc-error) 70 | (check (command-execute foo) => 'non-interactive) 71 | (check (call-interactively foo) => 'interactive) 72 | ;;; <+ Test Postscript>= 73 | ;(run-tests) 74 | (check-report) 75 | '(if (> (length test-errors) 0) 76 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 77 | (format #t "NO ERRORs in tests.")) 78 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 79 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/core.scm: -------------------------------------------------------------------------------- 1 | ;;; Layout for tests. 2 | ;;; 3 | ;;; = 4 | ;;; @subsection Legal Stuff 5 | ;;; 6 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 7 | ;;; 8 | ;;; Copyright (C) 2012, 2013 Shane Celis 9 | ;;; 10 | ;;; This file is part of Emacsy. 11 | ;;; 12 | ;;; Emacsy is free software: you can redistribute it and/or modify 13 | ;;; it under the terms of the GNU General Public License as published by 14 | ;;; the Free Software Foundation, either version 3 of the License, or 15 | ;;; (at your option) any later version. 16 | ;;; 17 | ;;; Emacsy is distributed in the hope that it will be useful, 18 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;;; GNU General Public License for more details. 21 | ;;; 22 | ;;; You should have received a copy of the GNU General Public License 23 | ;;; along with Emacsy. If not, see . 24 | (use-modules (check) 25 | (emacsy core) 26 | (emacsy event) 27 | (emacsy klecl) 28 | (oop goops) 29 | (srfi srfi-11)) 30 | 31 | (use-private-modules (emacsy core)) 32 | (set! emacsy-interactive? #t) 33 | 34 | ;;; <+ Test Preamble>= 35 | (use-modules (check)) 36 | (use-modules (ice-9 pretty-print)) 37 | (define test-errors '()) 38 | ;;; = 39 | (set! emacsy-interactive? #f) 40 | (check (eval-expression '(+ 1 2)) => 3) 41 | (set! emacsy-interactive? #t) 42 | ;;; One problem with this is I'd like to give completing-read a list of 43 | ;;; objects that will be converted to strings, but I'd like to get the 44 | ;;; object out rather than the string. I want something like this: 45 | ;;; 46 | ;;; 47 | ;;; = 48 | (check (let* ((symbols '(aa ab c d))) 49 | (let-values 50 | (((to-string from-string) (object-tracker symbol->string))) 51 | (map from-string (all-completions "a" (map to-string symbols))))) => '(aa ab)) 52 | ;;; We need to be able to deal with exceptions gracefully where ever they 53 | ;;; may pop up. 54 | ;;; 55 | ;;; 56 | ;;; = 57 | (define (good-hook) 58 | #t) 59 | (define (bad-hook) 60 | (throw 'some-error)) 61 | (define my-hook (make-hook 0)) 62 | 63 | (check-throw (run-hook my-hook) => 'no-throw) 64 | (check-throw (emacsy-run-hook my-hook) => 'no-throw) 65 | (check (emacsy-run-hook my-hook) => #t) 66 | (add-hook! my-hook good-hook) 67 | (check-throw (emacsy-run-hook my-hook) => 'no-throw) 68 | (add-hook! my-hook bad-hook) 69 | (check-throw (run-hook my-hook) => 'some-error) 70 | (check-throw (emacsy-run-hook my-hook) => 'no-throw) 71 | (check (emacsy-run-hook my-hook) => #f) 72 | ;;; = 73 | (emacsy-discard-input!) 74 | ;(emacsy-key-event #\a) 75 | (define mouse-event #f) 76 | (agenda-schedule (colambda () 77 | (format #t "START~%") 78 | (set! mouse-event (read-from-mouse)) 79 | (format #t "END~%"))) 80 | ;(with-blockable ) 81 | ;(block-tick) 82 | ;(check mouse-event => #f) 83 | ;(update-agenda) 84 | (emacsy-mouse-event #(0 0) 1 'down) 85 | (update-agenda) 86 | (check-true mouse-event) 87 | ;(block-tick) 88 | ;;; <+ Test Postscript>= 89 | ;(run-tests) 90 | (check-report) 91 | '(if (> (length test-errors) 0) 92 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 93 | (format #t "NO ERRORs in tests.")) 94 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 95 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/coroutine.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | (use-modules (emacsy coroutine) 21 | (check)) 22 | 23 | (define a (make-coroutine 24 | (lambda () 25 | (couser-data) 26 | ;; (yield (lambda (resume) 27 | ;; (resume 'b) 28 | ;; )) 29 | ;;'a 30 | ) 31 | 'a 32 | 'a-user-data)) 33 | 34 | (check (a) => 'a-user-data) 35 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/emacsy.scm: -------------------------------------------------------------------------------- 1 | ;;; = 2 | ;;; @subsection Legal Stuff 3 | ;;; 4 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 5 | ;;; 6 | ;;; Copyright (C) 2012, 2013 Shane Celis 7 | ;;; 8 | ;;; This file is part of Emacsy. 9 | ;;; 10 | ;;; Emacsy is free software: you can redistribute it and/or modify 11 | ;;; it under the terms of the GNU General Public License as published by 12 | ;;; the Free Software Foundation, either version 3 of the License, or 13 | ;;; (at your option) any later version. 14 | ;;; 15 | ;;; Emacsy is distributed in the hope that it will be useful, 16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;;; GNU General Public License for more details. 19 | ;;; 20 | ;;; You should have received a copy of the GNU General Public License 21 | ;;; along with Emacsy. If not, see . 22 | ;;; Finally, let's provide this as our testing preamble. 23 | ;;; 24 | ;;; 25 | ;;; <+ Test Preamble>= 26 | (use-modules (check)) 27 | (use-modules (ice-9 pretty-print)) 28 | 29 | ;;; = 30 | (define unit-tests '()) 31 | 32 | (define (register-test name func) 33 | (set! unit-tests (acons name func unit-tests))) 34 | 35 | ;;; The function register-test does the work, but we don't want to require 36 | ;;; the user to call it, so we'll define a macro that will automatically 37 | ;;; call it. 38 | ;;; 39 | ;;; 40 | ;;; = 41 | (define-syntax define-test 42 | (syntax-rules () 43 | ((define-test (name args ...) expr ...) 44 | (begin (define* (name args ...) 45 | expr ...) 46 | (register-test 'name name))))) 47 | ;;; Finally, now we just need a way to run all the unit tests. 48 | ;;; 49 | ;;; 50 | ;;; = 51 | (define test-errors '()) 52 | (define (run-tests) 53 | (catch 'first-error 54 | (lambda () (for-each (lambda (elt) 55 | (display "TEST: ") 56 | (pretty-print elt) 57 | (catch #t 58 | (lambda () 59 | (with-throw-handler #t 60 | (lambda () 61 | (apply (cdr elt) '())) 62 | (lambda args 63 | (set! test-errors (cons (car elt) test-errors)) 64 | (format #t "Error in test ~a: ~a" (car elt) args) 65 | 66 | (backtrace)))) 67 | (lambda args 68 | ;(throw 'first-error) 69 | #f 70 | ))) 71 | (reverse unit-tests))) 72 | (lambda args 73 | #f))) 74 | ;;; <+ Test Preamble>= 75 | (use-modules (check)) 76 | (use-modules (ice-9 pretty-print)) 77 | (define test-errors '()) 78 | (eval-when (compile load eval) 79 | (module-use! (current-module) (resolve-module '(emacsy)))) 80 | 81 | 82 | ;;; Let's run these tests at the end. 83 | ;;; 84 | ;;; 85 | ;;; <+ Test Postscript>= 86 | 87 | (run-tests) 88 | (check-report) 89 | (if (> (length test-errors) 0) 90 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 91 | (format #t "NO ERRORs in tests.")) 92 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 93 | 94 | ;;; <+ Test Postscript>= 95 | ;(run-tests) 96 | (check-report) 97 | '(if (> (length test-errors) 0) 98 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 99 | (format #t "NO ERRORs in tests.")) 100 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 101 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/event.scm: -------------------------------------------------------------------------------- 1 | ;;; Layout for tests. 2 | ;;; 3 | ;;; = 4 | ;;; @subsection Legal Stuff 5 | ;;; 6 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 7 | ;;; 8 | ;;; Copyright (C) 2012, 2013 Shane Celis 9 | ;;; 10 | ;;; This file is part of Emacsy. 11 | ;;; 12 | ;;; Emacsy is free software: you can redistribute it and/or modify 13 | ;;; it under the terms of the GNU General Public License as published by 14 | ;;; the Free Software Foundation, either version 3 of the License, or 15 | ;;; (at your option) any later version. 16 | ;;; 17 | ;;; Emacsy is distributed in the hope that it will be useful, 18 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;;; GNU General Public License for more details. 21 | ;;; 22 | ;;; You should have received a copy of the GNU General Public License 23 | ;;; along with Emacsy. If not, see . 24 | (use-modules (emacsy event) 25 | (oop goops) 26 | ) 27 | 28 | (eval-when (compile load eval) 29 | ;; Some trickery so we can test private procedures. 30 | (module-use! (current-module) (resolve-module '(emacsy event)))) 31 | 32 | ;;; <+ Test Preamble>= 33 | (use-modules (check)) 34 | (use-modules (ice-9 pretty-print)) 35 | (define test-errors '()) 36 | ;;; = 37 | (check-true (make #:command-char #\a)) 38 | ;;; = 39 | (check (strip-off-modifier-keys "C-a") => '((control) "a")) 40 | (check (strip-off-modifier-keys "a") => '(() "a")) 41 | (check (strip-off-modifier-keys "asdf") => '(() "asdf")) 42 | ;;; = 43 | (check (modifier-char->symbol #\S) => 'shift) 44 | (check (modifier-char->symbol #\X) => #f) 45 | ;;; = 46 | (check-true (memq 'kbd-entry->key-event (alist-keys kbd-converter-functions))) 47 | ;;; One issue we have with the above is the following: 48 | ;;; 49 | ;;; 50 | ;;; = 51 | (check (modifier-keys (kbd-entry->key-event "C-C-C-x")) => '(control control control)) 52 | ;;; Let's test our canonization of a properly formed but non-canonical event. 53 | ;;; 54 | ;;; 55 | ;;; = 56 | (let ((key-event (kbd-entry->event "S-C-C-S-a"))) 57 | (check (modifier-keys key-event) => '(shift control control shift)) 58 | (check (command-char key-event) => #\a) 59 | (canonize-event! key-event) 60 | (check (modifier-keys key-event) => '(control)) 61 | (check (command-char key-event) => #\A)) 62 | ;;; = 63 | (check (kbd "S-C-C-S-a") => '("C-A")) 64 | (check (kbd "S-C-C-S-A") => '("C-A")) 65 | ;;; = 66 | (check (event->kbd (make #:command-char #\a)) => "a") 67 | ;;; = 68 | (check (event->kbd (make #:command-char #\a 69 | #:modifier-keys '(control))) => "C-a") 70 | ;;; = 71 | (check (kbd "mouse-1") => '("mouse-1")) 72 | (check (kbd "S-S-mouse-1") => '("S-mouse-1")) 73 | ;;; <+ Test Postscript>= 74 | ;(run-tests) 75 | (check-report) 76 | '(if (> (length test-errors) 0) 77 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 78 | (format #t "NO ERRORs in tests.")) 79 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 80 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/help.scm: -------------------------------------------------------------------------------- 1 | ;;; = 2 | ;;; @subsection Legal Stuff 3 | ;;; 4 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 5 | ;;; 6 | ;;; Copyright (C) 2012, 2013 Shane Celis 7 | ;;; 8 | ;;; This file is part of Emacsy. 9 | ;;; 10 | ;;; Emacsy is free software: you can redistribute it and/or modify 11 | ;;; it under the terms of the GNU General Public License as published by 12 | ;;; the Free Software Foundation, either version 3 of the License, or 13 | ;;; (at your option) any later version. 14 | ;;; 15 | ;;; Emacsy is distributed in the hope that it will be useful, 16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;;; GNU General Public License for more details. 19 | ;;; 20 | ;;; You should have received a copy of the GNU General Public License 21 | ;;; along with Emacsy. If not, see . 22 | (use-modules (check) 23 | (emacsy help)) 24 | (use-private-modules (emacsy help)) 25 | 26 | 27 | 28 | (check-exit) 29 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/job.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; 5 | ;;; This file is part of Emacsy. 6 | ;;; 7 | ;;; Emacsy is free software: you can redistribute it and/or modify 8 | ;;; it under the terms of the GNU General Public License as published by 9 | ;;; the Free Software Foundation, either version 3 of the License, or 10 | ;;; (at your option) any later version. 11 | ;;; 12 | ;;; Emacsy is distributed in the hope that it will be useful, 13 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | ;;; GNU General Public License for more details. 16 | ;;; 17 | ;;; You should have received a copy of the GNU General Public License 18 | ;;; along with Emacsy. If not, see . 19 | 20 | (use-modules (emacsy coroutine) 21 | (emacsy agenda) 22 | (emacsy job) 23 | (ice-9 receive) 24 | (check)) 25 | 26 | (use-private-modules (emacsy job)) 27 | 28 | (set! next-job-id 1) 29 | 30 | (check *current-job-list* => '()) 31 | 32 | (define a (make-job (lambda () 33 | (get-job-id)))) 34 | 35 | 36 | (check *current-job-list* => (list (%make-job 1 'baby #f #f))) 37 | 38 | (check (a) => 1) 39 | 40 | (check *current-job-list* => (list (%make-job 1 'zombie 1 #f))) 41 | 42 | (check-throw (a) => 'job-already-started) 43 | 44 | (check *current-job-list* => (list (%make-job 1 'zombie 1 #f))) 45 | 46 | (set! *current-job-list* '()) 47 | 48 | (define b (make-job (lambda () 49 | 1 50 | (wait) 51 | 2))) 52 | 53 | (check *current-job-list* => (list (%make-job 2 'baby #f #f))) 54 | (check (b) => *unspecified*) 55 | (check *current-job-list* => (list (%make-job 2 'running #f #f))) 56 | (check-throw (b) => 'job-already-started) 57 | (check *current-job-list* => (list (%make-job 2 'running #f #f))) 58 | (update-agenda) 59 | (check *current-job-list* => (list (%make-job 2 'zombie 2 #f))) 60 | 61 | (set! *current-job-list* '()) 62 | 63 | (define c (make-job (lambda () 64 | 1 65 | (wait) 66 | 2))) 67 | 68 | (check *current-job-list* => (list (%make-job 3 'baby #f #f))) 69 | (check (c) => *unspecified*) 70 | (check *current-job-list* => (list (%make-job 3 'running #f #f))) 71 | (check-throw (c) => 'job-already-started) 72 | (check *current-job-list* => (list (%make-job 3 'running #f #f))) 73 | (suspend-job (car *current-job-list*)) 74 | (check *current-job-list* => (list (%make-job 3 'suspended #f #f))) 75 | (update-agenda) 76 | (check (job-state (car *current-job-list*)) => 'suspended) 77 | (continue-job (car *current-job-list*)) 78 | (check *current-job-list* => (list (%make-job 3 'running #f #f))) 79 | (update-agenda) 80 | (check *current-job-list* => (list (%make-job 3 'zombie 2 #f))) 81 | 82 | (set! *current-job-list* '()) 83 | 84 | (define d (make-job (lambda () 85 | 1 86 | (job-exit 3) 87 | 2))) 88 | 89 | (check *current-job-list* => (list (%make-job 4 'baby #f #f))) 90 | (check (d) => 3) 91 | (check *current-job-list* => (list (%make-job 4 'zombie 3 #f))) 92 | 93 | (set! *current-job-list* '()) 94 | 95 | (define e (make-job 96 | (lambda () 97 | (receive (proc job) 98 | (make-job (lambda () 99 | (wait) 100 | 'f)) 101 | (wait) 102 | (proc) 103 | (wait-for-job job))))) 104 | 105 | 106 | (check *current-job-list* => (list (%make-job 5 'baby #f #f))) 107 | (e) 108 | (check *current-job-list* => (list (%make-job 6 'baby #f #f) 109 | (%make-job 5 'running #f #f))) 110 | (update-agenda) 111 | (check *current-job-list* => (list (%make-job 6 'running #f #f) 112 | (%make-job 5 'running #f #f))) 113 | (update-agenda) 114 | (check *current-job-list* => (list (%make-job 6 'zombie 'f #f) 115 | (%make-job 5 'zombie 'f #f))) 116 | 117 | (check (format #f "~a" (car *current-job-list*)) => "#") 118 | 119 | (check-report) 120 | (check-exit) 121 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/kbd-macro.scm: -------------------------------------------------------------------------------- 1 | ;;; Layout for tests. 2 | ;;; 3 | ;;; = 4 | ;;; @subsection Legal Stuff 5 | ;;; 6 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 7 | ;;; 8 | ;;; Copyright (C) 2012, 2013 Shane Celis 9 | ;;; 10 | ;;; This file is part of Emacsy. 11 | ;;; 12 | ;;; Emacsy is free software: you can redistribute it and/or modify 13 | ;;; it under the terms of the GNU General Public License as published by 14 | ;;; the Free Software Foundation, either version 3 of the License, or 15 | ;;; (at your option) any later version. 16 | ;;; 17 | ;;; Emacsy is distributed in the hope that it will be useful, 18 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;;; GNU General Public License for more details. 21 | ;;; 22 | ;;; You should have received a copy of the GNU General Public License 23 | ;;; along with Emacsy. If not, see . 24 | (use-modules (emacsy kbd-macro) 25 | (emacsy event) 26 | (emacsy command) 27 | (emacsy klecl) 28 | (oop goops) 29 | (check)) 30 | 31 | (use-private-modules (emacsy kbd-macro)) 32 | 33 | (set! emacsy-interactive? #t) 34 | 35 | ;;; <+ Test Preamble>= 36 | (use-modules (check)) 37 | (use-modules (ice-9 pretty-print)) 38 | (define test-errors '()) 39 | ;;; Let's set up a command to test our functionality with. 40 | ;;; 41 | ;;; 42 | ;;; = 43 | (define test-command-called 0) 44 | (define test-keymap (make-keymap)) 45 | (define-interactive (test-command) 46 | (incr! test-command-called)) 47 | 48 | (define-key test-keymap (kbd "a") 'test-command) 49 | (set! default-klecl-maps (lambda () (list test-keymap))) 50 | 51 | (check test-command-called => 0) 52 | (kmacro-start-macro) 53 | (emacsy-key-event #\a) 54 | (emacsy-key-event #\b) ;; this executes no command. 55 | (primitive-command-loop (lambda args #f)) 56 | (primitive-command-loop (lambda args #f)) 57 | (kmacro-end-macro) 58 | (check test-command-called => 1) 59 | (check (map command-char last-kbd-macro) => '(#\b #\a)) 60 | (execute-kbd-macro last-kbd-macro) 61 | (check test-command-called => 2) 62 | ;;; = 63 | (check test-command-called => 2) 64 | (execute-temporal-kbd-macro last-kbd-macro) 65 | (primitive-command-loop (lambda args #f)) 66 | (check test-command-called => 3) 67 | ;;; <+ Test Postscript>= 68 | ;(run-tests) 69 | (check-report) 70 | '(if (> (length test-errors) 0) 71 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 72 | (format #t "NO ERRORs in tests.")) 73 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 74 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/keymap.scm: -------------------------------------------------------------------------------- 1 | ;;; Layout for tests. 2 | ;;; 3 | ;;; = 4 | ;;; @subsection Legal Stuff 5 | ;;; 6 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 7 | ;;; 8 | ;;; Copyright (C) 2012, 2013 Shane Celis 9 | ;;; 10 | ;;; This file is part of Emacsy. 11 | ;;; 12 | ;;; Emacsy is free software: you can redistribute it and/or modify 13 | ;;; it under the terms of the GNU General Public License as published by 14 | ;;; the Free Software Foundation, either version 3 of the License, or 15 | ;;; (at your option) any later version. 16 | ;;; 17 | ;;; Emacsy is distributed in the hope that it will be useful, 18 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20 | ;;; GNU General Public License for more details. 21 | ;;; 22 | ;;; You should have received a copy of the GNU General Public License 23 | ;;; along with Emacsy. If not, see . 24 | (use-modules (emacsy keymap) 25 | (emacsy event) 26 | (oop goops)) 27 | 28 | (eval-when (compile load eval) 29 | ;; Some trickery so we can test private procedures. 30 | (module-use! (current-module) (resolve-module '(emacsy keymap)))) 31 | 32 | ;;; <+ Test Preamble>= 33 | (use-modules (check)) 34 | (use-modules (ice-9 pretty-print)) 35 | (define test-errors '()) 36 | ;;; = 37 | (check-true (make )) 38 | ;;; The core functionality of the keymap is being able to define and look 39 | ;;; up key bindings. 40 | ;;; 41 | ;;; @subsection Lookup Key 42 | ;;; 43 | ;;; The procedure [[lookup-key]] return a keymap or symbol for a given 44 | ;;; list of keys. Consider this test keymap 45 | ;;; 46 | ;;; 47 | ;;; = 48 | (define (self-insert-command) #f) ;; make a fake command 49 | (define (mouse-drag-region) #f) ;; make a fake command 50 | (define (find-file-at-point) #f) ;; make a fake command 51 | (define k (make-keymap)) 52 | (define-key k "a" 'self-insert-command) 53 | (define-key k "mouse-1" 'mouse-drag-region) 54 | (define-key k "C-x C-f" 'find-file-at-point) 55 | ;;; \noindent [[lookup-key]] should behave in the following way. 56 | ;;; 57 | ;;; 58 | ;;; = 59 | (define (lookup-key* . args) 60 | (let ((result (apply lookup-key args))) 61 | (if (procedure? result) 62 | (procedure-name result) 63 | result))) 64 | (check (lookup-key* k '("a")) => 'self-insert-command-trampoline) 65 | (check (lookup-key* k "a") => 'self-insert-command-trampoline) 66 | (check (lookup-key k '("b")) => #f) 67 | (check (lookup-key k "M-x b") => #f) 68 | (check-true (keymap? (lookup-key k '("C-x")))) 69 | (check (lookup-key k "C-x C-f a b" #f) => 2) 70 | ;;; Because delivering the errors using booleans and numbers is a little 71 | ;;; cumbersome (and perhaps should be replaced with exceptions?), 72 | ;;; sometimes we just want to see if there is something in the keymap. 73 | ;;; 74 | ;;; 75 | ;;; = 76 | (check (lookup-key? k "C-x") => #f) 77 | (check (lookup-key? k "C-x C-f") => #t) 78 | (check (lookup-key? k "a") => #t) 79 | ;;; @subsection Define Key 80 | ;;; 81 | ;;; The procedure [[define-key]] may return a number indicating an error, 82 | ;;; or a keymap indicating it worked. 83 | ;;; 84 | ;;; 85 | ;;; = 86 | ;(check (define-key k (kbd "C-x C-f C-a C-b") 'nope) => 2) 87 | ;;; = 88 | (check-true (keymap? (make ))) 89 | (check-false (keymap? 1)) 90 | ;;; <+ Test Postscript>= 91 | ;(run-tests) 92 | (check-report) 93 | '(if (> (length test-errors) 0) 94 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 95 | (format #t "NO ERRORs in tests.")) 96 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 97 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/minibuffer-test-dir/bin/run-test: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/test/minibuffer-test-dir/bin/run-test -------------------------------------------------------------------------------- /3rdparty/emacsy/test/minibuffer-test-dir/empty-dir/.dummy: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/test/minibuffer-test-dir/empty-dir/.dummy -------------------------------------------------------------------------------- /3rdparty/emacsy/test/minibuffer-test-dir/exam/.dummy: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/test/minibuffer-test-dir/exam/.dummy -------------------------------------------------------------------------------- /3rdparty/emacsy/test/minibuffer-test-dir/minibuffer-a: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/test/minibuffer-test-dir/minibuffer-a -------------------------------------------------------------------------------- /3rdparty/emacsy/test/minibuffer-test-dir/minibuffer-b: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/3rdparty/emacsy/test/minibuffer-test-dir/minibuffer-b -------------------------------------------------------------------------------- /3rdparty/emacsy/test/mru-stack.scm: -------------------------------------------------------------------------------- 1 | ;;; = 2 | ;;; @subsection Legal Stuff 3 | ;;; 4 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 5 | ;;; 6 | ;;; Copyright (C) 2012, 2013 Shane Celis 7 | ;;; 8 | ;;; This file is part of Emacsy. 9 | ;;; 10 | ;;; Emacsy is free software: you can redistribute it and/or modify 11 | ;;; it under the terms of the GNU General Public License as published by 12 | ;;; the Free Software Foundation, either version 3 of the License, or 13 | ;;; (at your option) any later version. 14 | ;;; 15 | ;;; Emacsy is distributed in the hope that it will be useful, 16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;;; GNU General Public License for more details. 19 | ;;; 20 | ;;; You should have received a copy of the GNU General Public License 21 | ;;; along with Emacsy. If not, see . 22 | (use-modules (emacsy mru-stack) 23 | (check)) 24 | 25 | (use-private-modules (emacsy mru-stack)) 26 | ;;; = 27 | (define s (make )) 28 | (mru-add! s 'a) 29 | (mru-add! s 'b) 30 | (mru-add! s 'c) 31 | (check (mru-list s) => '(c b a)) 32 | (check (mru-recall! s 'a) => '(a c b)) 33 | (check (mru-ref s) => 'a) 34 | (mru-next! s) 35 | (check (mru-ref s) => 'c) 36 | (mru-next! s) 37 | (check (mru-ref s) => 'b) 38 | (mru-next! s) 39 | (check (mru-ref s) => 'a) 40 | (mru-prev! s) 41 | (check (mru-ref s) => 'b) 42 | (check (mru-list s) => '(a c b)) 43 | (mru-remove! s 'c) 44 | (check (mru-list s) => '(a b)) 45 | (check (mru-ref s) => 'b) 46 | (mru-remove! s 'a) 47 | (mru-remove! s 'b) 48 | (check (mru-list s) => '()) 49 | (check (mru-ref s) => #f) 50 | (mru-next! s) 51 | (check (mru-ref s) => #f) 52 | (mru-add! s 'a) 53 | (mru-add! s 'b) 54 | (mru-add! s 'c) 55 | (check (mru-list s) => '(c b a)) 56 | (mru-remove! s 'c) 57 | (check (mru-list s) => '(b a)) 58 | (check (mru-ref s) => 'b) 59 | (let ((ms (make ))) 60 | (for-each (lambda (x) (mru-add! ms x)) '(a b c)) 61 | (mru-next! ms) 62 | (mru-remove! ms 'a) 63 | (mru-remove! ms 'b) 64 | (mru-remove! ms 'c) 65 | (check (mru-list ms) => '())) 66 | (check-exit) 67 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/self-doc.scm: -------------------------------------------------------------------------------- 1 | ;;; = 2 | ;;; @subsection Legal Stuff 3 | ;;; 4 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 5 | ;;; 6 | ;;; Copyright (C) 2012, 2013 Shane Celis 7 | ;;; 8 | ;;; This file is part of Emacsy. 9 | ;;; 10 | ;;; Emacsy is free software: you can redistribute it and/or modify 11 | ;;; it under the terms of the GNU General Public License as published by 12 | ;;; the Free Software Foundation, either version 3 of the License, or 13 | ;;; (at your option) any later version. 14 | ;;; 15 | ;;; Emacsy is distributed in the hope that it will be useful, 16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;;; GNU General Public License for more details. 19 | ;;; 20 | ;;; You should have received a copy of the GNU General Public License 21 | ;;; along with Emacsy. If not, see . 22 | (use-modules (check) 23 | (emacsy self-doc)) 24 | (use-private-modules (emacsy self-doc)) 25 | 26 | ;;; = 27 | (define (this-module) (current-module)) 28 | (define-variable x 1 "This is the variable x.") 29 | (check x => 1) 30 | ;;(check (documentation (module-variable (this-module) 'x)) => "This is the variable x.") 31 | (check (documentation 'x) => "This is the variable x.") 32 | (define-variable x 2 "This is the variable x.") 33 | (check x => 1) 34 | (check (documentation 'x) => "This is the variable x.") 35 | (set! x 3) 36 | (check x => 3) 37 | (check (documentation 'x) => "This is the variable x.") 38 | 39 | ;; When we re-define x, the documentation stays. 40 | (define x 4) 41 | (check (documentation 'x) => "This is the variable x.") 42 | (check x => 4) 43 | (define-variable x 5 "This is the variable x; it is!") 44 | (check x => 4) 45 | (check (documentation 'x) => "This is the variable x; it is!") 46 | 47 | (define-variable x 5 "This is the variable x.") 48 | ;;; = 49 | (check (emacsy-collect-kind (current-module) 'variable) => '(x)) 50 | ;;; = 51 | (define-parameter y 1 "This is the parameter y.") 52 | (check y => 1) 53 | (check (documentation 'y) => "This is the parameter y.") 54 | (define-parameter y 2 "This is the parameter y.") 55 | (check y => 2) 56 | (check (documentation 'y) => "This is the parameter y.") 57 | (set! y 3) 58 | (check y => 3) 59 | (check (documentation 'y) => "This is the parameter y.") 60 | ;(check (object-properties (module-variable (current-module) 'y)) => '()) 61 | (check (emacsy-collect-kind (current-module) 'parameter) => '(y)) 62 | (define emacsy-collect-all-kind emacsy-collect-kind) 63 | (check (emacsy-collect-all-kind (current-module) 'parameter 0) => '(y)) 64 | 65 | ;;; Now let's try to start a new module. And probe some of the behavior. 66 | ;;; 67 | ;;; 68 | ;;; = 69 | (define-module (test-this) 70 | #:use-module (check) 71 | #:use-module (emacsy self-doc)) 72 | 73 | 74 | (check (emacsy-collect-kind (current-module) 'parameter) => '()) 75 | (check (emacsy-collect-kind (current-module) 'variable) => '()) 76 | (check (module-name (current-module)) => '(test-this)) 77 | 78 | ;; XXX These two tests behave differently on GNU/Linux and Mac OS X. 79 | ;(check (module-variable (current-module) 'x) => #f) 80 | ;(check (documentation 'x) => #f) 81 | ;(check (documentation 'y) => #f) 82 | 83 | (use-private-modules (guile-user)) 84 | 85 | (check x => 4) 86 | (check y => 3) 87 | (check (documentation 'x) => "This is the variable x.") 88 | ;;(check (documentation (module-variable (this-module) 'x)) => "This is the variable x.") 89 | (check (documentation 'y) => "This is the parameter y.") 90 | ;;(check (documentation (module-variable (this-module) 'y)) => "This is the parameter y.") 91 | (check (emacsy-collect-kind (current-module) 'variable) => '()) 92 | (check (emacsy-collect-kind (current-module) 'parameter) => '()) 93 | 94 | (check (emacsy-collect-all-kind (current-module) 'variable) => '()) 95 | (check (emacsy-collect-all-kind (current-module) 'parameter) => '()) 96 | 97 | (check (emacsy-collect-all-kind (current-module) 'variable 1) => '(x)) 98 | (check (emacsy-collect-all-kind (current-module) 'parameter 1) => '(y)) 99 | 100 | (check (string-suffix? "test/self-doc.scm" (assoc-ref (current-source-location) 'filename)) => #t) 101 | ;;(check (current-filename) => #f) 102 | (check (source-properties x) => '()) 103 | (check (source-properties 'x) => '()) 104 | (check (source-properties (module-variable (current-module) 'x)) => '()) 105 | 106 | (check-exit) 107 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/text.scm: -------------------------------------------------------------------------------- 1 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 2 | ;;; 3 | ;;; Copyright (C) 2012, 2013 Shane Celis 4 | ;;; Copyright (C) 2019 Jan (janneke) Nieuwenhuizen 5 | ;;; 6 | ;;; This file is part of Emacsy. 7 | ;;; 8 | ;;; Emacsy is free software: you can redistribute it and/or modify 9 | ;;; it under the terms of the GNU General Public License as published by 10 | ;;; the Free Software Foundation, either version 3 of the License, or 11 | ;;; (at your option) any later version. 12 | ;;; 13 | ;;; Emacsy is distributed in the hope that it will be useful, 14 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;;; GNU General Public License for more details. 17 | ;;; 18 | ;;; You should have received a copy of the GNU General Public License 19 | ;;; along with Emacsy. If not, see . 20 | (use-modules (check) 21 | (emacsy mru-stack) 22 | (emacsy buffer) 23 | (emacsy text) 24 | (emacsy command) 25 | (emacsy event) 26 | (emacsy keymap) 27 | (oop goops) 28 | (rnrs base)) 29 | 30 | (use-private-modules (emacsy buffer)) 31 | (use-private-modules (emacsy text)) 32 | 33 | ;;; <+ Test Preamble>= 34 | (use-modules (check)) 35 | (use-modules (ice-9 pretty-print)) 36 | (define test-errors '()) 37 | 38 | ;;; Let's test this regex search in a gap buffer. 39 | ;;; 40 | ;;; = 41 | (define c (make #:name "*test-regex*")) 42 | (add-buffer! c) 43 | (check (current-buffer) => c) 44 | (check (buffer-modified?) => #f) 45 | (check (buffer-modified-tick) => 0) 46 | (insert "hellos these ard words!") 47 | (check (buffer-modified?) => #t) 48 | (check (buffer-modified-tick) => 1) 49 | ;; 1 7 13 17 50 | (check (point) => (point-max)) 51 | (check (point-min) => 1) 52 | (goto-char (point-min)) 53 | (check (gb-char-after (gap-buffer c) 1) => #\h) 54 | (check (gb-char-before (gap-buffer c) 1) => #f) 55 | (check (point) => 1) 56 | (check (forward-word) => 7) 57 | (check (point) => 7) 58 | (check (char-before) => #\s) 59 | (check (char-after) => #\space) 60 | 61 | (check (forward-word 2) => 17) 62 | (check (char-before) => #\d) 63 | (check (char-after) => #\space) 64 | (check (backward-word) => 14) 65 | (check (char-before) => #\space) 66 | (check (char-after) => #\a) 67 | 68 | ;;#(!sdrow dra eseht solleh (17 . 24)) 69 | ;; 1 8 12 18 70 | ;; is ^ ^ 71 | ;; goto ^ 72 | ;; was ^ 73 | ;;; <+ Test Postscript>= 74 | ;(run-tests) 75 | (check-report) 76 | '(if (> (length test-errors) 0) 77 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 78 | (format #t "NO ERRORs in tests.")) 79 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 80 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/window.scm: -------------------------------------------------------------------------------- 1 | ;;; = 2 | ;;; @subsection Legal Stuff 3 | ;;; 4 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 5 | ;;; 6 | ;;; Copyright (C) 2012, 2013 Shane Celis 7 | ;;; 8 | ;;; This file is part of Emacsy. 9 | ;;; 10 | ;;; Emacsy is free software: you can redistribute it and/or modify 11 | ;;; it under the terms of the GNU General Public License as published by 12 | ;;; the Free Software Foundation, either version 3 of the License, or 13 | ;;; (at your option) any later version. 14 | ;;; 15 | ;;; Emacsy is distributed in the hope that it will be useful, 16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;;; GNU General Public License for more details. 19 | ;;; 20 | ;;; You should have received a copy of the GNU General Public License 21 | ;;; along with Emacsy. If not, see . 22 | ;;; <+ Test Preamble>= 23 | (use-modules (check)) 24 | (use-modules (ice-9 pretty-print)) 25 | (define test-errors '()) 26 | 27 | (use-modules (emacsy window)) 28 | (eval-when (compile load eval) 29 | (module-use! (current-module) (resolve-module '(emacsy window)))) 30 | ;;; = 31 | (check (window? root-window) => #t) 32 | ;;; = 33 | (check (window-live? root-window) => #t) 34 | ;;; = 35 | (check (edges->bcoords '(0 1 1 0)) => '(0 0 1 1)) 36 | ;;; = 37 | (check (bcoords->edges '(0 0 1 1)) => '(0 1 1 0)) 38 | ;;; Let's project a point in the current window to the point in its 39 | ;;; ultimate parent window. 40 | ;;; 41 | ;;; 42 | ;;; = 43 | (define i-window (make )) 44 | (define window (make )) 45 | (check (window? i-window) => #t) 46 | (check (window? window) => #t) 47 | ;;; Let's test window splitting. 48 | ;;; 49 | ;;; 50 | ;;; = 51 | (check (procedure? split-window) => #t) 52 | (define s-window (split-window window)) 53 | (check (is-a? s-window ) => #t) 54 | ;;; Let's test window splitting with a different size value. 55 | ;;; 56 | ;;; = 57 | (define small-window (make )) 58 | (define parent-window (split-window small-window 0.2)) 59 | (define big-window (cdr (window-children parent-window))) 60 | (check (orientation parent-window) => 'vertical) 61 | ;;; Let's test window splitting with a different orientation. 62 | ;;; 63 | ;;; 64 | ;;; = 65 | (define left-window (make )) 66 | (define parent-window-2 (split-window left-window 0.2 'right)) 67 | (define right-window (cdr (window-children parent-window-2))) 68 | (check (orientation parent-window-2) => 'horizontal) 69 | ;;; = 70 | (let* ((w (make )) 71 | (sw (split-window w)) 72 | (c (cadr (window-children sw))) 73 | (sc (split-window c)) 74 | (nc (cadr (window-children sc))) 75 | ) 76 | 77 | (check (window-list w) => (list w)) 78 | (check (window-tree sw) => (list w (list c nc))) 79 | (check (window-list sw) => (list w c nc)) 80 | ;(check (window-list sw) => (list w c #f)) 81 | ) 82 | 83 | 84 | ;;; <+ Test Postscript>= 85 | ;(run-tests) 86 | (check-report) 87 | '(if (> (length test-errors) 0) 88 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 89 | (format #t "NO ERRORs in tests.")) 90 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 91 | -------------------------------------------------------------------------------- /3rdparty/emacsy/test/windows.scm: -------------------------------------------------------------------------------- 1 | ;;; = 2 | ;;; @subsection Legal Stuff 3 | ;;; 4 | ;;; Emacsy --- An embeddable Emacs-like library using GNU Guile 5 | ;;; 6 | ;;; Copyright (C) 2012, 2013 Shane Celis 7 | ;;; 8 | ;;; This file is part of Emacsy. 9 | ;;; 10 | ;;; Emacsy is free software: you can redistribute it and/or modify 11 | ;;; it under the terms of the GNU General Public License as published by 12 | ;;; the Free Software Foundation, either version 3 of the License, or 13 | ;;; (at your option) any later version. 14 | ;;; 15 | ;;; Emacsy is distributed in the hope that it will be useful, 16 | ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 | ;;; GNU General Public License for more details. 19 | ;;; 20 | ;;; You should have received a copy of the GNU General Public License 21 | ;;; along with Emacsy. If not, see . 22 | ;;; <+ Test Preamble>= 23 | (use-modules (check)) 24 | (use-modules (ice-9 pretty-print)) 25 | (define test-errors '()) 26 | 27 | (use-modules (emacsy windows)) 28 | (use-private-modules (emacsy windows)) 29 | 30 | ;; (eval-when (compile load eval) 31 | ;; (module-use! (current-module) (resolve-module '(emacsy windows)))) 32 | ;;; = 33 | (check (window? root-window) => #t) 34 | ;;; = 35 | (check (window-live? root-window) => #t) 36 | ;;; = 37 | (check (edges->bcoords '(0 1 1 0)) => '(0 0 1 1)) 38 | ;;; = 39 | (check (bcoords->edges '(0 0 1 1)) => '(0 1 1 0)) 40 | ;;; = 41 | (define i-window (make )) 42 | (define window (make )) 43 | (check (window? i-window) => #t) 44 | (check (window? window) => #t) 45 | ;;; Let's test window splitting. 46 | ;;; 47 | ;;; 48 | ;;; = 49 | (check (procedure? split-window) => #t) 50 | (define s-window (split-window window)) 51 | (check (is-a? s-window ) => #t) 52 | (check (window-pixel-bcoords s-window) => '(0 0 1 1)) 53 | (check (window-pixel-bcoords window) => '(0. .5 1. .5)) 54 | ;;; Let's test window splitting with a different size value. 55 | ;;; 56 | ;;; = 57 | (define small-window (make )) 58 | (define parent-window (split-window small-window 0.2)) 59 | (define big-window (cdr (window-children parent-window))) 60 | (check (orientation parent-window) => 'vertical) 61 | (check (window-pixel-bcoords small-window) => '(0. .2 1. .2)) 62 | (check (window-pixel-bcoords big-window) => '(0. 0. 1. .8)) 63 | ;;; Let's test window splitting with a different orientation. 64 | ;;; 65 | ;;; 66 | ;;; = 67 | (define left-window (make )) 68 | (define parent-window-2 (split-window left-window 0.2 'right)) 69 | (define right-window (cdr (window-children parent-window-2))) 70 | (check (orientation parent-window-2) => 'horizontal) 71 | (check (window-pixel-bcoords left-window) => '(0. 0. .2 1.)) 72 | (check (window-pixel-bcoords right-window) => '(.2 .0 .8 1.)) 73 | ;;; Let's test the pixel-window at the top of the hierarchy. 74 | ;;; 75 | ;;; 76 | ;;; = 77 | (define pixel-window (make #:pixel-size '(500 400))) 78 | 79 | ;(update-window pixel-window) 80 | ;(define sub-window (window-child pixel-window)) 81 | (define sub-window (make )) 82 | (check (window? pixel-window) => #t) 83 | (check (window? sub-window) => #t) 84 | (set! (window-parent sub-window) pixel-window) 85 | (set! (window-child pixel-window) sub-window) 86 | (check (window-child pixel-window) => sub-window) 87 | (check (window-project sub-window #(1. 1. 1.)) => #(500. 400. 1.)) 88 | (check (window-project sub-window #(0. 0. 1.)) => #(0. 0. 1.)) 89 | (format #t "Splitting the window\n") 90 | (define sub-window-2 (split-window sub-window)) 91 | (check (window-project sub-window #(1. 1. 1.)) => #(500. 400. 1.)) 92 | (check (window-project sub-window #(0. 0. 1.)) => #(0. 200. 1.)) 93 | 94 | (check (window-unproject sub-window #(0. 200. 1.)) => #(0. 0. 1.)) 95 | ;;; = 96 | (let* ((w (make )) 97 | (sw (split-window w)) 98 | (c (cdr (window-children sw))) 99 | (sc (split-window c)) 100 | ) 101 | 102 | (check (window-list w) => (list w)) 103 | (check (window-tree sw) => (list w c)) 104 | (check (window-list sw) => (list w c)) 105 | (check (window-list sw) => (list w c #f)) 106 | ) 107 | ;;; = 108 | (check (window-project window #(0 0 1)) => #(0. .5 1.)) 109 | (check (window-project window #(1. 1. 1.)) => #(1. 1. 1.)) 110 | (check (window-unproject window #(0 .5 1.)) => #(0. 0. 1.)) 111 | (check (window-unproject window #(1. 1. 1.)) => #(1. 1. 1.)) 112 | 113 | ;;; <+ Test Postscript>= 114 | ;(run-tests) 115 | (check-report) 116 | '(if (> (length test-errors) 0) 117 | (format #t "~a ERROR in tests: ~a." (length test-errors) (reverse test-errors)) 118 | (format #t "NO ERRORs in tests.")) 119 | (exit (if (and (= (length test-errors) 0) (= 0 (length check:failed))) 0 1)) 120 | -------------------------------------------------------------------------------- /CMakeLists.txt: -------------------------------------------------------------------------------- 1 | cmake_minimum_required(VERSION 3.11) 2 | 3 | project(zem) 4 | 5 | set(CMAKE_CXX_STANDARD 17) 6 | 7 | list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake) 8 | 9 | set(TOPDIR ${PROJECT_SOURCE_DIR}) 10 | 11 | find_package(Guile REQUIRED) 12 | find_package(Readline REQUIRED) 13 | find_package(Freetype REQUIRED) 14 | 15 | find_package(glad) 16 | find_package(glfw3) 17 | find_package(glm) 18 | find_package(spdlog) 19 | 20 | include_directories(${TOPDIR}/include/ 21 | ${TOPDIR}/modules/emacsy/ 22 | ${GUILE_INCLUDE_DIR} 23 | ${FREETYPE_INCLUDE_DIRS} 24 | ) 25 | 26 | set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${PROJECT_BINARY_DIR}/bin) 27 | 28 | set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${PROJECT_BINARY_DIR}/lib) 29 | 30 | add_subdirectory(extensions) 31 | 32 | set(ZEM_SRCLIST 33 | src/main.cpp 34 | src/intern_string.cpp 35 | src/shader_program.cpp 36 | src/renderer.cpp 37 | src/font.cpp 38 | src/keymap.c 39 | src/rope.cpp 40 | src/api/api.cpp 41 | src/api/renderer.cpp 42 | src/api/font.cpp 43 | src/api/rope.cpp 44 | ) 45 | 46 | set(EXT_SRCLIST 47 | modules/emacsy/emacsy.c 48 | ) 49 | 50 | add_executable(zem ${ZEM_SRCLIST} ${EXT_SRCLIST}) 51 | 52 | target_link_libraries(zem glad::glad 53 | glfw 54 | glm::glm 55 | spdlog::spdlog 56 | ${GUILE_LIBRARY} 57 | ${READLINE_LIBRARY} 58 | ${FREETYPE_LIBRARIES}) 59 | 60 | set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${PROJECT_BINARY_DIR}/lib) 61 | 62 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | * ZEM 2 | Extensible Emacs-like text editor with GNU Guile Scheme. 3 | 4 | #+HTML:
5 | #+HTML: screenshot 6 | #+HTML:
7 | 8 | ** Features 9 | - Emacs-like editing: ZEM uses [[https://savannah.nongnu.org/projects/emacsy][Emacsy]] to provide an Emacsy feel (keymaps, minibuffer with completion, major & minor modes, etc.). Default key bindings are the same as vanilla Emacs (e.g. ~C-x C-f~ for ~find-file~). For the complete list of supported commands, use ~M-x TAB~. 10 | - Fully hackable and extensible with [[https://www.gnu.org/software/guile/][GNU Guile]] 11 | - [[https://github.com/tree-sitter/tree-sitter][Tree-sitter]] based syntax highlighting (currently only C++ is supported) 12 | 13 | ** Installation 14 | *** Requirements 15 | 1. GNU Guile 3.0+ (may support Guile 2.2 but not tested) 16 | 2. CMake (>= 3.11) 17 | 3. [[https://conan.io/][Conan]] 18 | 4. [[https://tiswww.case.edu/php/chet/readline/rltop.html][GNU Readline]] 19 | 5. [[https://www.freetype.org/][Freetype]] 20 | 21 | *** Building 22 | Clone this repo first: 23 | #+BEGIN_SRC shell 24 | git clone https://github.com/Jimx-/zem.git 25 | cd zem 26 | git submodule update --init --recursive 27 | #+END_SRC 28 | 29 | Build the editor with: 30 | #+BEGIN_SRC shell 31 | mkdir build 32 | conan install . --output-folder=build --build=missing --settings=build_type=Debug 33 | cd build 34 | ln -s ../data/monospace.ttf 35 | cmake .. -DCMAKE_BUILD_TYPE=Debug -DCMAKE_TOOLCHAIN_FILE=conan_toolchain.cmake 36 | make 37 | #+END_SRC 38 | 39 | ** Usage 40 | Under the ~build~ directory, run: 41 | #+BEGIN_SRC shell 42 | ../run.sh 43 | #+END_SRC 44 | -------------------------------------------------------------------------------- /cmake/FindGuile.cmake: -------------------------------------------------------------------------------- 1 | # Copyright (c) 2008, 2014 OpenCog.org (http://opencog.org) 2 | # 3 | # Redistribution and use is allowed according to the terms of the BSD license. 4 | # For details see the accompanying COPYING-CMAKE-SCRIPTS file. 5 | 6 | # - Try to find Guile; Once done this will define 7 | # 8 | # GUILE_FOUND - system has the GUILE library 9 | # GUILE_INCLUDE_DIRS - the GUILE include directory 10 | # GUILE_LIBRARIES - The libraries needed to use GUILE 11 | # GUILE_VERSION_STRING - Version 12 | # GUILE_SITE_DIR - site dir 13 | # GUILE_EXTENSION_DIR - extension dir 14 | # GUILE_ROOT_DIR - prefix dir 15 | 16 | # Look for the header file 17 | # Look for guile-2.2 first, then 2.0, then 1.8 18 | # Macports for OSX puts things in /opt/local 19 | find_path (GUILE_INCLUDE_DIR libguile.h 20 | PATH_SUFFIXES 21 | guile/3.0 22 | guile/2.2 23 | guile/2.0 24 | guile/1.8 25 | libguile 26 | guile 27 | HINTS /opt/local/include 28 | ) 29 | 30 | # Look for the library 31 | find_library (GUILE_LIBRARY NAMES guile-3.0 guile-2.2 guile-2.0 guile 32 | HINTS 33 | /opt/local/lib 34 | ) 35 | 36 | 37 | set (GUILE_LIBRARIES ${GUILE_LIBRARY}) 38 | set (GUILE_INCLUDE_DIRS ${GUILE_INCLUDE_DIR}) 39 | 40 | 41 | # check guile's version if we're using cmake >= 2.6 42 | if (GUILE_INCLUDE_DIR) 43 | SET(GUILE_VERSION_MAJOR 0) 44 | SET(GUILE_VERSION_MINOR 0) 45 | SET(GUILE_VERSION_PATCH 0) 46 | 47 | IF(NOT EXISTS "${GUILE_INCLUDE_DIR}/libguile/version.h") 48 | MESSAGE(FATAL_ERROR "Found ${GUILE_INCLUDE_DIR}/libguile.h but not version.h; check your guile installation!") 49 | ENDIF(NOT EXISTS "${GUILE_INCLUDE_DIR}/libguile/version.h") 50 | 51 | # Extract the libguile version from the 'version.h' file 52 | SET(GUILE_MAJOR_VERSION 0) 53 | FILE(READ "${GUILE_INCLUDE_DIR}/libguile/version.h" _GUILE_VERSION_H_CONTENTS) 54 | 55 | STRING(REGEX MATCH "#define SCM_MAJOR_VERSION[ ]+([0-9])" _MATCH "${_GUILE_VERSION_H_CONTENTS}") 56 | SET(GUILE_VERSION_MAJOR ${CMAKE_MATCH_1}) 57 | STRING(REGEX MATCH "#define SCM_MINOR_VERSION[ ]+([0-9]+)" _MATCH "${_GUILE_VERSION_H_CONTENTS}") 58 | SET(GUILE_VERSION_MINOR ${CMAKE_MATCH_1}) 59 | STRING(REGEX MATCH "#define SCM_MICRO_VERSION[ ]+([0-9]+)" _MATCH "${_GUILE_VERSION_H_CONTENTS}") 60 | SET(GUILE_VERSION_PATCH ${CMAKE_MATCH_1}) 61 | 62 | SET(GUILE_VERSION_STRING "${GUILE_VERSION_MAJOR}.${GUILE_VERSION_MINOR}.${GUILE_VERSION_PATCH}") 63 | 64 | endif () 65 | 66 | find_program(GUILE_EXECUTABLE 67 | NAMES guile 68 | ) 69 | 70 | find_program(GUILE_CONFIG_EXECUTABLE 71 | NAMES guile-config 72 | ) 73 | 74 | 75 | if (GUILE_CONFIG_EXECUTABLE) 76 | execute_process (COMMAND ${GUILE_CONFIG_EXECUTABLE} info prefix 77 | OUTPUT_VARIABLE GUILE_ROOT_DIR 78 | OUTPUT_STRIP_TRAILING_WHITESPACE) 79 | 80 | execute_process (COMMAND ${GUILE_CONFIG_EXECUTABLE} info sitedir 81 | OUTPUT_VARIABLE GUILE_SITE_DIR 82 | OUTPUT_STRIP_TRAILING_WHITESPACE) 83 | 84 | execute_process (COMMAND ${GUILE_CONFIG_EXECUTABLE} info extensiondir 85 | OUTPUT_VARIABLE GUILE_EXTENSION_DIR 86 | OUTPUT_STRIP_TRAILING_WHITESPACE) 87 | endif () 88 | 89 | # IF(GUILE_FOUND AND GUILE_VERSION_MAJOR EQUAL 2) 90 | # ADD_DEFINITIONS(-DHAVE_GUILE2) 91 | # ENDIF(GUILE_FOUND AND GUILE_VERSION_MAJOR EQUAL 2) 92 | 93 | # handle REQUIRED and QUIET options 94 | include (FindPackageHandleStandardArgs) 95 | find_package_handle_standard_args (Guile REQUIRED_VARS GUILE_EXECUTABLE GUILE_ROOT_DIR GUILE_INCLUDE_DIRS GUILE_LIBRARIES VERSION_VAR GUILE_VERSION_STRING) 96 | 97 | 98 | mark_as_advanced (GUILE_INCLUDE_DIR GUILE_LIBRARY) -------------------------------------------------------------------------------- /cmake/FindReadline.cmake: -------------------------------------------------------------------------------- 1 | # FindReadline.cmake 2 | # 3 | # This file is part of NEST. 4 | # 5 | # Copyright (C) 2004 The NEST Initiative 6 | # 7 | # NEST is free software: you can redistribute it and/or modify 8 | # it under the terms of the GNU General Public License as published by 9 | # the Free Software Foundation, either version 2 of the License, or 10 | # (at your option) any later version. 11 | # 12 | # NEST is distributed in the hope that it will be useful, 13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | # GNU General Public License for more details. 16 | # 17 | # You should have received a copy of the GNU General Public License 18 | # along with NEST. If not, see . 19 | 20 | # - Find GNU Readline header and library 21 | # 22 | # This module defines 23 | # READLINE_FOUND, if false, do not try to use GNU Readline. 24 | # READLINE_INCLUDE_DIRS, where to find readline/readline.h. 25 | # READLINE_LIBRARIES, the libraries to link against to use GNU Readline. 26 | # READLINE_VERSION, the library version 27 | # 28 | # As a hint allows READLINE_ROOT_DIR 29 | 30 | 31 | find_path( READLINE_INCLUDE_DIR 32 | NAMES readline/readline.h 33 | HINTS ${READLINE_ROOT_DIR}/include 34 | NO_SYSTEM_ENVIRONMENT_PATH # anaconda python tries to be first in path and hides a useful readline 35 | ) 36 | find_library( READLINE_LIBRARY 37 | NAMES readline 38 | HINTS ${READLINE_ROOT_DIR}/lib 39 | NO_SYSTEM_ENVIRONMENT_PATH # anaconda python tries to be first in path and hides a useful readline 40 | ) 41 | find_library( NCURSES_LIBRARY # readline depends on libncurses, or similar 42 | NAMES ncurses ncursesw curses termcap 43 | HINTS ${READLINE_ROOT_DIR}/lib 44 | ) 45 | 46 | if ( EXISTS "${READLINE_INCLUDE_DIR}/readline/readline.h" ) 47 | file( STRINGS "${READLINE_INCLUDE_DIR}/readline/readline.h" readline_h_content 48 | REGEX "#define RL_READLINE_VERSION" ) 49 | string( REGEX REPLACE ".*0x([0-9][0-9])([0-9][0-9]).*" "\\1.\\2" 50 | READLINE_VERSION ${readline_h_content} ) 51 | string( REGEX REPLACE "^0" "" READLINE_VERSION ${READLINE_VERSION} ) 52 | string( REPLACE ".0" "." READLINE_VERSION ${READLINE_VERSION} ) 53 | endif () 54 | 55 | include( FindPackageHandleStandardArgs ) 56 | find_package_handle_standard_args( Readline 57 | FOUND_VAR 58 | READLINE_FOUND 59 | REQUIRED_VARS 60 | READLINE_LIBRARY 61 | NCURSES_LIBRARY 62 | READLINE_INCLUDE_DIR 63 | VERSION_VAR 64 | READLINE_VERSION 65 | ) 66 | 67 | if ( READLINE_FOUND ) 68 | set( READLINE_LIBRARIES "${READLINE_LIBRARY}" "${NCURSES_LIBRARY}" ) 69 | set( READLINE_INCLUDE_DIRS "${READLINE_INCLUDE_DIR}" ) 70 | endif () 71 | 72 | mark_as_advanced( READLINE_ROOT_DIR READLINE_INCLUDE_DIR READLINE_LIBRARY NCURSES_LIBRARY ) -------------------------------------------------------------------------------- /conanfile.txt: -------------------------------------------------------------------------------- 1 | [requires] 2 | glad/0.1.33 3 | glfw/3.3.2 4 | glm/0.9.9.8 5 | spdlog/[>=1.4.1] 6 | tree-sitter/0.24.3 7 | tree-sitter-c/0.23.1 8 | 9 | [generators] 10 | CMakeDeps 11 | CMakeToolchain 12 | 13 | [options] 14 | glad/*:gl_version = 4.3 15 | -------------------------------------------------------------------------------- /data/monospace.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Jimx-/zem/ce87bea8a3b4ae3d46ab167ec610a694e618f582/data/monospace.ttf -------------------------------------------------------------------------------- /extensions/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | add_subdirectory(tree-sitter) 2 | add_subdirectory(tree-sitter-cc) 3 | -------------------------------------------------------------------------------- /extensions/tree-sitter-cc/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | find_package(tree-sitter REQUIRED) 2 | find_package(tree-sitter-c REQUIRED) 3 | 4 | set(EXT_SRCLIST tree-sitter-cpp/src/parser.c 5 | tree-sitter-cpp/src/scanner.c) 6 | 7 | add_library(guile-tree-sitter-cc MODULE tree-sitter-cc.c ${EXT_SRCLIST}) 8 | 9 | target_link_libraries(guile-tree-sitter-cc 10 | tree-sitter::tree-sitter 11 | tree-sitter-c::tree-sitter-c) 12 | -------------------------------------------------------------------------------- /extensions/tree-sitter-cc/tree-sitter-cc.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | const TSLanguage* tree_sitter_c(void); 5 | const TSLanguage* tree_sitter_cpp(void); 6 | 7 | static SCM language_type; 8 | 9 | static SCM zem_ts_language_c() 10 | { 11 | return scm_make_foreign_object_1(language_type, (void*)tree_sitter_c()); 12 | } 13 | 14 | static SCM zem_ts_language_cpp() 15 | { 16 | return scm_make_foreign_object_1(language_type, (void*)tree_sitter_cpp()); 17 | } 18 | 19 | void init_tree_sitter_cc() 20 | { 21 | SCM name, slots; 22 | scm_t_struct_finalize finalizer; 23 | 24 | name = scm_from_utf8_symbol("tree-sitter-language"); 25 | slots = scm_list_1(scm_from_utf8_symbol("data")); 26 | language_type = scm_make_foreign_object_type(name, slots, NULL); 27 | 28 | scm_c_define_gsubr("tree-sitter-language-c", 0, 0, 0, 29 | (void*)zem_ts_language_c); 30 | scm_c_define_gsubr("tree-sitter-language-cpp", 0, 0, 0, 31 | (void*)zem_ts_language_cpp); 32 | } 33 | -------------------------------------------------------------------------------- /extensions/tree-sitter/CMakeLists.txt: -------------------------------------------------------------------------------- 1 | find_package(tree-sitter REQUIRED) 2 | 3 | add_library(guile-tree-sitter MODULE tree-sitter.cpp ${EXT_SRCLIST}) 4 | 5 | target_link_libraries(guile-tree-sitter tree-sitter::tree-sitter) 6 | -------------------------------------------------------------------------------- /include/color_value.h: -------------------------------------------------------------------------------- 1 | #ifndef _ZEM_COLOR_VALUE_H 2 | #define _ZEM_COLOR_VALUE_H 3 | 4 | #include 5 | #include 6 | 7 | namespace zem { 8 | 9 | struct ColorValue { 10 | unsigned char r, g, b, a; 11 | 12 | explicit ColorValue(unsigned char red, unsigned char green, 13 | unsigned char blue, unsigned char alpha = 255) 14 | : r(red), g(green), b(blue), a(alpha) 15 | {} 16 | 17 | static inline ColorValue from_u32(unsigned int val) 18 | { 19 | int base_shift = 0; 20 | unsigned char alpha = 255; 21 | 22 | if (val >= 0x1000000) { 23 | base_shift = 8; 24 | alpha = val & 0xff; 25 | } 26 | 27 | return ColorValue{(unsigned char)((val >> (base_shift + 16)) & 0xff), 28 | (unsigned char)((val >> (base_shift + 8)) & 0xff), 29 | (unsigned char)((val >> base_shift) & 0xff), alpha}; 30 | } 31 | 32 | inline unsigned int as_u32() const 33 | { 34 | return (a << 24) | (b << 16) | (g << 8) | r; 35 | } 36 | 37 | inline unsigned char operator[](size_t i) const 38 | { 39 | assert(i < 4); 40 | return *(&r + i); 41 | } 42 | 43 | inline unsigned char& operator[](size_t i) 44 | { 45 | assert(i < 4); 46 | return *(&r + i); 47 | } 48 | 49 | inline unsigned char* ptr() { return &r; } 50 | 51 | inline const unsigned char* ptr() const { return &r; } 52 | 53 | ColorValue operator+(const ColorValue& v) const 54 | { 55 | return ColorValue(r + v.r, g + v.g, b + v.b, a + v.a); 56 | } 57 | 58 | ColorValue& operator+=(const ColorValue& v) 59 | { 60 | r += v.r; 61 | g += v.g; 62 | b += v.b; 63 | a += v.a; 64 | 65 | return *this; 66 | } 67 | 68 | ColorValue operator-(const ColorValue& v) const 69 | { 70 | return ColorValue(r - v.r, g - v.g, b - v.b, a - v.a); 71 | } 72 | 73 | ColorValue operator*(const ColorValue& v) const 74 | { 75 | return ColorValue(r * v.r, g * v.g, b * v.b, a * v.a); 76 | } 77 | 78 | ColorValue operator*(float f) const 79 | { 80 | return ColorValue(r * f, g * f, b * f, a * f); 81 | } 82 | 83 | ColorValue& operator*=(float f) 84 | { 85 | r *= f; 86 | g *= f; 87 | b *= f; 88 | a *= f; 89 | 90 | return *this; 91 | } 92 | }; 93 | 94 | } // namespace zem 95 | 96 | #endif 97 | -------------------------------------------------------------------------------- /include/font.h: -------------------------------------------------------------------------------- 1 | #ifndef _ZEM_FONT_H 2 | #define _ZEM_FONT_H 3 | 4 | #include 5 | 6 | #include 7 | #include FT_FREETYPE_H 8 | 9 | #include 10 | #include 11 | 12 | namespace zem { 13 | 14 | struct GlyphInfo { 15 | float x0, y0, x1, y1; 16 | float u0, v0, u1, v1; 17 | float x_advance; 18 | }; 19 | 20 | struct FontAtlas { 21 | unsigned int tex_id; 22 | unsigned int tex_width, tex_height; 23 | 24 | static const int GLYPH_COUNT = 256; 25 | GlyphInfo glyphs[GLYPH_COUNT]; 26 | 27 | FontAtlas() { memset(this, 0, sizeof(*this)); } 28 | }; 29 | 30 | class Font { 31 | public: 32 | Font(const std::string& filename, unsigned int size_pixels); 33 | ~Font(); 34 | 35 | unsigned int get_height_pixels() const; 36 | 37 | std::tuple find_glyph(uint32_t codepoint); 38 | 39 | private: 40 | std::string filename; 41 | unsigned int size_pixels; 42 | FT_Face face; 43 | std::unordered_map atlas_set; 44 | 45 | void load_atlas(unsigned int idx, FontAtlas& atlas); 46 | }; 47 | 48 | } // namespace zem 49 | 50 | #endif 51 | -------------------------------------------------------------------------------- /include/intern_string.h: -------------------------------------------------------------------------------- 1 | #ifndef _ZEM_INTERN_STRING_H 2 | #define _ZEM_INTERN_STRING_H 3 | 4 | #include 5 | #include 6 | 7 | namespace zem { 8 | 9 | namespace detail { 10 | 11 | class InternStringDetail { 12 | public: 13 | std::string data; 14 | 15 | InternStringDetail(const char* str, size_t len) : data(str, str + len) {} 16 | bool operator==(const InternStringDetail& rhs) const 17 | { 18 | return data == rhs.data; 19 | } 20 | 21 | InternStringDetail& operator=(const InternStringDetail& rhs) = delete; 22 | }; 23 | 24 | } // namespace detail 25 | 26 | class InternString { 27 | public: 28 | InternString(const char* str, size_t len = -1) 29 | : detail(intern(str, (len == -1) ? strlen(str) : len)) 30 | {} 31 | InternString(const std::string& str) 32 | : detail(intern(str.c_str(), str.length())) 33 | {} 34 | 35 | bool operator==(const InternString& rhs) const 36 | { 37 | return detail == rhs.detail; 38 | } 39 | bool operator!=(const InternString& rhs) const 40 | { 41 | return detail != rhs.detail; 42 | } 43 | bool operator<(const InternString& rhs) const 44 | { 45 | return detail < rhs.detail; 46 | } 47 | 48 | size_t length() const { return detail->data.length(); } 49 | const char* c_str() const { return detail->data.c_str(); } 50 | 51 | private: 52 | static detail::InternStringDetail* intern(const char* str, size_t len); 53 | 54 | detail::InternStringDetail* detail; 55 | }; 56 | 57 | } // namespace zem 58 | 59 | #endif 60 | -------------------------------------------------------------------------------- /include/keymap.h: -------------------------------------------------------------------------------- 1 | #ifndef _ZEM_KEYMAP_H 2 | #define _ZEM_KEYMAP_H 3 | 4 | #ifdef __cplusplus 5 | extern "C" 6 | { 7 | #endif 8 | 9 | #define SHIFT_COL 0 10 | 11 | extern const int zem_keymap[256][1]; 12 | 13 | #ifdef __cplusplus 14 | } 15 | #endif 16 | 17 | #endif 18 | -------------------------------------------------------------------------------- /include/renderer.h: -------------------------------------------------------------------------------- 1 | #ifndef _ZEM_RENDERER_H 2 | #define _ZEM_RENDERER_H 3 | 4 | #include "color_value.h" 5 | #include "font.h" 6 | #include "shader_program.h" 7 | #include "singleton.h" 8 | #include "vector2.h" 9 | 10 | #include 11 | #include 12 | 13 | namespace zem { 14 | 15 | class CommandBuffer; 16 | 17 | class Renderer : public Singleton { 18 | public: 19 | Renderer(); 20 | 21 | void set_display_size(unsigned int width, unsigned int height) 22 | { 23 | display_width = width; 24 | display_height = height; 25 | } 26 | 27 | void add_rect(const Vector2& p_min, const Vector2& p_max, 28 | const ColorValue& color); 29 | Vector2 add_text(Font* font, const Vector2& pos, const std::string& text, 30 | const ColorValue& color, float max_width = 0); 31 | 32 | Vector2 text_size_hint(Font* font, const std::string& text, 33 | float max_width = 0); 34 | unsigned int char_offset(Font* font, const std::string& text, 35 | float x_offset); 36 | 37 | void push_clip_rect(const Vector2& pos, const Vector2& size); 38 | void pop_clip_rect(); 39 | 40 | void begin_frame(); 41 | void end_frame(); 42 | 43 | private: 44 | unsigned int display_width; 45 | unsigned int display_height; 46 | 47 | std::unique_ptr program_color; 48 | std::unique_ptr program_texcolor; 49 | 50 | std::unique_ptr command_buffer; 51 | 52 | GLuint VAO, VBO, EBO; 53 | 54 | void init_resources(); 55 | 56 | void setup_state(); 57 | }; 58 | 59 | void init_renderer(); 60 | 61 | } // namespace zem 62 | 63 | #define RENDERER (zem::Renderer::get_singleton()) 64 | 65 | #endif 66 | -------------------------------------------------------------------------------- /include/rope.h: -------------------------------------------------------------------------------- 1 | #ifndef _ROPE_H_ 2 | #define _ROPE_H_ 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | namespace zem { 11 | 12 | namespace detail { 13 | 14 | struct BaseNode { 15 | unsigned int height; 16 | size_t len; 17 | size_t lines; 18 | 19 | explicit BaseNode(unsigned int height, size_t len, size_t lines) 20 | : height(height), len(len), lines(lines) 21 | {} 22 | 23 | virtual bool is_ok_child() const = 0; 24 | virtual const std::vector>* 25 | get_children() const = 0; 26 | virtual std::string_view get_value() const { return ""; } 27 | 28 | virtual std::optional push_str(std::string_view str) = 0; 29 | 30 | virtual std::shared_ptr clone() const = 0; 31 | }; 32 | 33 | using PNode = std::shared_ptr; 34 | 35 | struct InternalNode : BaseNode { 36 | static constexpr size_t MIN_CHILDREN = 4; 37 | static constexpr size_t MAX_CHILDREN = 8; 38 | 39 | std::vector children; 40 | 41 | explicit InternalNode(std::vector&& children) 42 | : BaseNode(children[0]->height + 1, 0, 0), children(children) 43 | { 44 | for (auto&& p : children) { 45 | len += p->len; 46 | lines += p->lines; 47 | } 48 | } 49 | 50 | virtual bool is_ok_child() const { return children.size() >= MIN_CHILDREN; } 51 | 52 | virtual const std::vector* get_children() const { return &children; } 53 | 54 | virtual std::optional push_str(std::string_view str) 55 | { 56 | return {}; 57 | } 58 | 59 | virtual PNode clone() const 60 | { 61 | return std::make_shared(std::vector{children}); 62 | } 63 | }; 64 | 65 | struct LeafNode : BaseNode { 66 | static constexpr size_t MIN_LEAF = 511; 67 | static constexpr size_t MAX_LEAF = 1024; 68 | 69 | std::string val; 70 | 71 | explicit LeafNode(std::string_view val); 72 | 73 | static size_t find_leaf_split(std::string_view str, size_t minsplit); 74 | 75 | virtual bool is_ok_child() const { return len >= MIN_LEAF; } 76 | 77 | virtual const std::vector* get_children() const { return nullptr; } 78 | virtual std::string_view get_value() const { return val; } 79 | 80 | virtual std::optional push_str(std::string_view str); 81 | 82 | virtual PNode clone() const { return std::make_shared(val); } 83 | }; 84 | 85 | struct Metric { 86 | virtual size_t measure(detail::BaseNode* node, size_t len) const = 0; 87 | 88 | virtual bool is_boundary(std::string_view str, off_t offset) const = 0; 89 | 90 | virtual std::optional next(std::string_view str, 91 | off_t offset) const = 0; 92 | }; 93 | 94 | } // namespace detail 95 | 96 | class Rope { 97 | friend class RopeBuilder; 98 | 99 | private: 100 | detail::PNode root; 101 | 102 | Rope(detail::PNode&& root) : root(root) {} 103 | 104 | static detail::PNode merge_nodes(const std::vector& lhs, 105 | const std::vector& rhs); 106 | 107 | static detail::PNode merge_leaves(const detail::PNode& lhs, 108 | const detail::PNode& rhs); 109 | 110 | static detail::PNode concat(const detail::PNode& lhs, 111 | const detail::PNode& rhs); 112 | 113 | static size_t count_node_lines(detail::PNode node, size_t start, 114 | size_t end); 115 | 116 | public: 117 | class Cursor { 118 | friend Rope; 119 | 120 | private: 121 | static constexpr size_t CURSOR_CACHE_SIZE = 4; 122 | 123 | detail::PNode root; 124 | size_t position; 125 | std::array, CURSOR_CACHE_SIZE> cache; 126 | 127 | std::optional leaf; 128 | size_t leaf_offset; 129 | 130 | void descend(); 131 | void descend_metric(size_t measure, const detail::Metric* metric); 132 | 133 | std::optional next_leaf(); 134 | 135 | std::optional next_in_leaf(const detail::Metric* metric); 136 | 137 | std::optional next(const detail::Metric* metric); 138 | 139 | size_t measure_leaf(size_t pos, const detail::Metric* metric); 140 | 141 | public: 142 | explicit Cursor(detail::PNode root, size_t position) 143 | : root(root), position(position), leaf(std::nullopt), leaf_offset(0) 144 | { 145 | descend(); 146 | } 147 | 148 | size_t get_position() const { return position; } 149 | std::optional get_leaf_value() const { return leaf; } 150 | size_t get_leaf_offset() const { return position - leaf_offset; } 151 | 152 | std::optional next_line(); 153 | }; 154 | 155 | static constexpr size_t npos = (size_t)-1; 156 | 157 | size_t length() const { return root->len; } 158 | 159 | void clear(); 160 | 161 | void edit(size_t start, size_t end, std::string_view new_str); 162 | 163 | std::string substr(size_t pos, size_t len = npos) const; 164 | 165 | off_t next_lines(off_t pos, size_t count = 1); 166 | 167 | size_t count_lines(size_t pos, size_t len = npos) const; 168 | }; 169 | 170 | class RopeBuilder { 171 | friend class Rope; 172 | 173 | private: 174 | std::vector> stack; 175 | 176 | void push(detail::PNode node); 177 | void push_slice(detail::PNode node, size_t start, size_t end); 178 | 179 | detail::PNode pop(); 180 | 181 | public: 182 | void push_leaf(std::string_view str); 183 | 184 | Rope build(); 185 | }; 186 | 187 | } // namespace zem 188 | 189 | #endif 190 | -------------------------------------------------------------------------------- /include/shader_program.h: -------------------------------------------------------------------------------- 1 | #ifndef _ZEM_SHADER_PROGRAM_H 2 | #define _ZEM_SHADER_PROGRAM_H 3 | 4 | #include "intern_string.h" 5 | 6 | #include 7 | #include 8 | #include 9 | 10 | namespace zem { 11 | 12 | class BaseShaderProgram { 13 | public: 14 | typedef InternString UniformID; 15 | 16 | struct Binding { 17 | int first, second; 18 | 19 | Binding(int first = -1, int second = -1) : first(first), second(second) 20 | {} 21 | }; 22 | 23 | virtual ~BaseShaderProgram() {} 24 | 25 | virtual void bind() = 0; 26 | virtual void unbind() = 0; 27 | 28 | virtual GLuint get_program() const = 0; 29 | 30 | bool is_valid() const { return _valid; } 31 | 32 | void uniform(UniformID id, float v0, float v1 = 0.0f, float v2 = 0.0f, 33 | float v3 = 0.0f); 34 | void uniform(UniformID id, int v0, int v1 = 0, int v2 = 0, int v3 = 0); 35 | void uniform(UniformID id, GLsizei count, GLboolean transpose, 36 | const GLfloat* mat); 37 | 38 | protected: 39 | BaseShaderProgram(); 40 | bool _valid; 41 | 42 | virtual Binding get_uniform_binding(UniformID id) = 0; 43 | 44 | virtual void uniform_(const Binding& b, float v0, float v1, float v2, 45 | float v3) = 0; 46 | virtual void uniform_(const Binding& b, int v0, int v1, int v2, int v3) = 0; 47 | virtual void uniform_(const Binding& b, GLsizei count, GLboolean transpose, 48 | const GLfloat* mat) = 0; 49 | }; 50 | 51 | class GLSLShaderProgram : public BaseShaderProgram { 52 | public: 53 | GLSLShaderProgram(const std::string& vertex_code, 54 | const std::string& fragment_code); 55 | virtual ~GLSLShaderProgram(); 56 | 57 | virtual void bind(); 58 | virtual void unbind(); 59 | 60 | virtual GLuint get_program() const { return program; } 61 | 62 | private: 63 | std::string vertex_code; 64 | std::string fragment_code; 65 | 66 | GLuint program; 67 | GLuint vertex_shader; 68 | GLuint fragment_shader; 69 | 70 | std::map> uniforms; 71 | 72 | bool compile(GLuint shader, const std::string& code); 73 | bool link(); 74 | 75 | virtual Binding get_uniform_binding(UniformID id); 76 | virtual void uniform_(const Binding& b, float v0, float v1, float v2, 77 | float v3); 78 | virtual void uniform_(const Binding& b, int v0, int v1, int v2, int v3); 79 | virtual void uniform_(const Binding& b, GLsizei count, GLboolean transpose, 80 | const GLfloat* mat); 81 | }; 82 | 83 | } // namespace zem 84 | 85 | #endif 86 | -------------------------------------------------------------------------------- /include/singleton.h: -------------------------------------------------------------------------------- 1 | #ifndef _ZEM_SINGLETON_H 2 | #define _ZEM_SINGLETON_H 3 | 4 | /* Template class for creating single instance classes */ 5 | 6 | namespace zem { 7 | 8 | template class Singleton { 9 | public: 10 | Singleton() { singleton = static_cast(this); } 11 | 12 | Singleton(const Singleton&) = delete; 13 | Singleton& operator=(const Singleton&) = delete; 14 | 15 | ~Singleton() { singleton = nullptr; } 16 | 17 | static T& get_singleton() { return *singleton; } 18 | 19 | static T* get_singleton_ptr() { return singleton; } 20 | 21 | protected: 22 | static T* singleton; 23 | }; 24 | 25 | } // namespace zem 26 | 27 | #endif 28 | -------------------------------------------------------------------------------- /include/vector2.h: -------------------------------------------------------------------------------- 1 | #ifndef _ZEM_VECTOR2_H 2 | #define _ZEM_VECTOR2_H 3 | 4 | #include 5 | #include 6 | #include 7 | 8 | namespace zem { 9 | 10 | struct Vector2 { 11 | public: 12 | float x, y; 13 | 14 | Vector2(float x = 0.0, float y = 0.0) : x(x), y(y) {} 15 | 16 | Vector2(const float coords[2]) : x(coords[0]), y(coords[1]) {} 17 | 18 | inline float operator[](size_t i) const 19 | { 20 | assert(i < 2); 21 | return *(&x + i); 22 | } 23 | 24 | inline float& operator[](size_t i) 25 | { 26 | assert(i < 2); 27 | return *(&x + i); 28 | } 29 | 30 | inline float* ptr() { return &x; } 31 | 32 | inline const float* ptr() const { return &x; } 33 | 34 | Vector2 operator+(const Vector2& v) const 35 | { 36 | return Vector2(x + v.x, y + v.y); 37 | } 38 | 39 | Vector2& operator+=(const Vector2& v) 40 | { 41 | x += v.x; 42 | y += v.y; 43 | 44 | return *this; 45 | } 46 | 47 | Vector2 operator-(const Vector2& v) const 48 | { 49 | return Vector2(x - v.x, y - v.y); 50 | } 51 | 52 | Vector2 operator*(const Vector2& v) const 53 | { 54 | return Vector2(x * v.x, y * v.y); 55 | } 56 | 57 | Vector2 operator*(float f) const { return Vector2(x * f, y * f); } 58 | 59 | Vector2& operator*=(float f) 60 | { 61 | x *= f; 62 | y *= f; 63 | 64 | return *this; 65 | } 66 | 67 | float dot(const Vector2& v) const { return x * v.x + y * v.y; } 68 | 69 | float length() const 70 | { 71 | float s = x * x + y * y; 72 | return (float)sqrt(s); 73 | } 74 | 75 | void normalize() 76 | { 77 | float len = length(); 78 | 79 | if (len != 0.0f) { 80 | float inv = 1.0f / len; 81 | x *= inv; 82 | y *= inv; 83 | } 84 | } 85 | 86 | static Vector2 lerp(const Vector2& l, const Vector2& r, float t) 87 | { 88 | return r * t + l * (1.0f - t); 89 | } 90 | }; 91 | 92 | } // namespace zem 93 | 94 | #endif 95 | -------------------------------------------------------------------------------- /modules/emacsy: -------------------------------------------------------------------------------- 1 | ../3rdparty/emacsy/emacsy -------------------------------------------------------------------------------- /modules/zem/core/buffer.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem core buffer) 2 | #:use-module (zem core mode) 3 | #:use-module (zem api rope) 4 | #:use-module (emacsy emacsy) 5 | #:use-module (ice-9 match) 6 | #:use-module (ice-9 curried-definitions) 7 | #:use-module (rnrs io ports) 8 | #:use-module (oop goops) 9 | #:use-module (srfi srfi-1)) 10 | 11 | (define-public (position-bytes pos) pos) 12 | 13 | (define-public (get-buffer name) 14 | (find (lambda (buffer) 15 | (string=? (buffer-name buffer) name)) 16 | (buffer-list))) 17 | 18 | (define-public (get-buffer-create name) 19 | (or (get-buffer name) 20 | (let ((new-buffer (make #:name name))) 21 | (add-buffer! new-buffer) 22 | new-buffer))) 23 | 24 | (define-public (bolp) 25 | (let ((c (char-before))) 26 | (and c (eqv? c #\newline)))) 27 | 28 | (define newline-regex (make-regexp "\\\n")) 29 | 30 | (define-method (buffer:count-lines (buffer ) start end) 31 | (with-buffer buffer 32 | (if (> end start) 33 | (string-count (substring (buffer-string) start (- end start)) #\newline) 34 | 0))) 35 | 36 | (define-method (buffer:count-lines (buffer ) start end) 37 | (if (> end start) 38 | (rope-count-lines (rope-buffer buffer) start (- end start)) 39 | 0)) 40 | 41 | (define-public (count-lines start end) 42 | (save-excursion 43 | (let ((lines (buffer:count-lines (current-buffer) start end))) 44 | (goto-char end) 45 | (if (and (> end start) 46 | (not (bolp))) 47 | (1+ lines) 48 | lines)))) 49 | 50 | (define-interactive (count-lines-page) 51 | (let ((total (count-lines (point-min) (point-max))) 52 | (before (count-lines (point-min) (point))) 53 | (after (count-lines (point) (point-max)))) 54 | (message "Page has ~a line(s) (~a + ~a)" total before after))) 55 | 56 | (define*-public (line-number-at-pos #:optional (pos (point))) 57 | (let ((lines (count-lines (point-min) pos))) 58 | (if (bolp) 59 | (1+ lines) 60 | lines))) 61 | 62 | (define-method (buffer:next-lines (buffer ) count) 63 | (with-buffer buffer 64 | (re-search-forward newline-regex #f #t (max 0 count)))) 65 | 66 | (define-method (buffer:next-lines (buffer ) count) 67 | (rope-next-lines (rope-buffer buffer) count)) 68 | 69 | (define-interactive (goto-line #:optional line) 70 | #t) 71 | (define-interactive (goto-line #:optional (line (string->number 72 | (read-from-minibuffer "Goto line: ")))) 73 | (goto-char (point-min)) 74 | (buffer:next-lines (current-buffer) (1- line))) 75 | (define-key global-map "M-g M-g" 'goto-line) 76 | 77 | (define (after-find-file) 78 | (set-auto-mode)) 79 | 80 | (add-hook! find-file-hook after-find-file) 81 | 82 | (define-interactive (save-buffer #:optional arg) 83 | (if (buffer-modified?) 84 | (let ((filename (or (buffer-file-name (current-buffer)) 85 | (expand-file-name (read-file-name "File to save in: "))))) 86 | (call-with-output-file filename (lambda (port) (put-string port (buffer-string)))) 87 | (set! (buffer-modified? (current-buffer)) #f) 88 | (message "Wrote ~a" filename)) 89 | (message "(No changes need to be saved)"))) 90 | (define-key global-map "C-x C-s" 'save-buffer) 91 | -------------------------------------------------------------------------------- /modules/zem/core/commands.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem core commands) 2 | #:use-module (emacsy emacsy) 3 | #:use-module (zem core buffer) 4 | #:use-module (zem core mode) 5 | #:use-module (zem progmodes cc-mode) 6 | #:use-module (statprof)) 7 | 8 | (define-interactive (profiler-start) 9 | (statprof-start)) 10 | 11 | (define-interactive (profiler-end) 12 | (statprof-stop)) 13 | 14 | (define-interactive (profiler-report) 15 | (statprof-display)) 16 | -------------------------------------------------------------------------------- /modules/zem/core/faces.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem core faces) 2 | #:use-module (zem util plist) 3 | #:export (define-face 4 | set-face-attribute 5 | face-attribute)) 6 | 7 | (define face-attribute-alist '()) 8 | 9 | (define-syntax define-face 10 | (syntax-rules () 11 | ((_ face spec) 12 | (set-face-spec (quote face) spec)))) 13 | 14 | (define (face-spec-match-display display) 15 | (eq? display #t)) 16 | 17 | (define (face-spec-choose spec defaults) 18 | (if (null? spec) 19 | defaults 20 | (let* ((display (caar spec)) 21 | (attrs (cdar spec)) 22 | (defaults (if (eq? display 'default) 23 | defaults 24 | attrs))) 25 | (if (face-spec-match-display display) 26 | attrs 27 | (face-spec-choose (cdr spec) defaults))))) 28 | 29 | (define (set-face-attribute face . args) 30 | (let* ((old-attrs (or (assq-ref face-attribute-alist face) 31 | '())) 32 | (new-attrs (apply plist-new old-attrs args))) 33 | (set! face-attribute-alist 34 | (assoc-set! face-attribute-alist face new-attrs)))) 35 | 36 | (define (set-face-spec face spec) 37 | (let ((attrs (face-spec-choose spec '()))) 38 | (apply set-face-attribute face attrs))) 39 | 40 | (define* (face-attribute face attribute #:optional (inherit? #f)) 41 | (let ((attrs (assq-ref face-attribute-alist face))) 42 | (or (plist-get attrs attribute) 43 | (if inherit? 44 | (let ((inh-from (face-attribute face ':inherit))) 45 | (if (eq? inh-from 'unspecified) 46 | 'unspecified 47 | (face-attribute inh-from attribute #t))) 48 | 'unspecified)))) 49 | 50 | (define-face default '((#t))) 51 | 52 | (define-face bold '((#t :weight bold))) 53 | 54 | (define-face fixed-pitch '((#t))) 55 | 56 | (define-face line-number '((#t :inherit default))) 57 | 58 | (define-face line-number-current-line '((#t :inherit default))) 59 | 60 | (define-face mode-line '((#t :background #x757575))) 61 | 62 | (define-face cursor '((#t))) 63 | 64 | (define-face scroll-bar '((#t))) 65 | 66 | (define-face window-divider '((#t))) 67 | 68 | (define-face highlight '((#t))) 69 | 70 | (define-face region '((#t :background #x7f7f7f))) 71 | 72 | (define-face minibuffer-prompt '((#t :foreground #x00ffff))) 73 | -------------------------------------------------------------------------------- /modules/zem/core/font-lock.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem core font-lock) 2 | #:use-module (zem core faces) 3 | #:use-module (zem core mode) 4 | #:export (font-lock-mode)) 5 | 6 | (define-public font-lock-comment-face 'font-lock-comment-face) 7 | (define-public font-lock-string-face 'font-lock-string-face) 8 | (define-public font-lock-builtin-face 'font-lock-builtin-face) 9 | (define-public font-lock-keyword-face 'font-lock-keyword-face) 10 | (define-public font-lock-function-name-face 'font-lock-function-name-face) 11 | (define-public font-lock-variable-name-face 'font-lock-variable-name-face) 12 | (define-public font-lock-type-face 'font-lock-type-face) 13 | (define-public font-lock-constant-face 'font-lock-constant-face) 14 | (define-public font-lock-preprocessor-face 'font-lock-preprocessor-face) 15 | 16 | (define-face font-lock-comment-face '((t :inherit fixed-pitch))) 17 | 18 | (define-face font-lock-string-face '((t :inherit fixed-pitch))) 19 | 20 | (define-face font-lock-keyword-face '((t :inherit fixed-pitch))) 21 | 22 | (define-face font-lock-function-name-face '((t :inherit fixed-pitch))) 23 | 24 | (define-face font-lock-variable-name-face '((t :inherit fixed-pitch))) 25 | 26 | (define-face font-lock-type-face '((t :inherit fixed-pitch))) 27 | 28 | (define-face font-lock-constant-face '((t :inherit fixed-pitch))) 29 | 30 | (define-face font-lock-preprocessor-face '((t :inherit fixed-pitch))) 31 | 32 | (define-minor-mode font-lock-mode #f "Font-Lock") 33 | -------------------------------------------------------------------------------- /modules/zem/init.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem init) 2 | #:use-module (zem api font) 3 | #:use-module (zem core faces) 4 | #:use-module (zem core font-lock) 5 | #:use-module (zem themes doom-one) 6 | #:use-module (emacsy emacsy)) 7 | 8 | ;; (set! debug-on-error? #t) 9 | 10 | (define default-font (load-font 11 | "monospace.ttf" 12 | 13)) 13 | 14 | (set-face-attribute 'default ':font default-font) 15 | (set-face-attribute 'fixed-pitch ':font default-font) 16 | -------------------------------------------------------------------------------- /modules/zem/progmodes/cc-mode.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem progmodes cc-mode) 2 | #:use-module (zem core mode) 3 | #:use-module (zem progmodes prog-mode) 4 | #:use-module (zem syntax tree-sitter) 5 | #:use-module (emacsy emacsy) 6 | #:use-module (ice-9 regex) 7 | #:export (enter-c++-mode)) 8 | 9 | (load-extension "libguile-tree-sitter-cc" "init_tree_sitter_cc") 10 | 11 | (define-derived-mode c++-mode prog-mode "C++") 12 | 13 | (set! auto-mode-alist (cons `(,(make-regexp "\\.cpp\\'") . ,c++-mode) auto-mode-alist)) 14 | 15 | (define tree-sitter-highlight-patterns-cpp 16 | "[\"break\" 17 | \"case\" 18 | \"const\" 19 | \"continue\" 20 | \"default\" 21 | \"do\" 22 | \"else\" 23 | \"enum\" 24 | \"extern\" 25 | \"for\" 26 | \"if\" 27 | \"inline\" 28 | \"return\" 29 | \"sizeof\" 30 | \"static\" 31 | \"struct\" 32 | \"switch\" 33 | \"typedef\" 34 | \"union\" 35 | \"volatile\" 36 | \"while\" 37 | \"...\"] @keyword 38 | 39 | [(storage_class_specifier) 40 | (type_qualifier)] @keyword 41 | 42 | [\"#define\" 43 | \"#else\" 44 | \"#endif\" 45 | \"#if\" 46 | \"#ifdef\" 47 | \"#ifndef\" 48 | \"#include\" 49 | (preproc_directive)] @function.macro 50 | 51 | (([\"#ifdef\" \"#ifndef\"] (identifier) @constant)) 52 | 53 | [\"+\" \"-\" \"*\" \"/\" \"%\" 54 | \"~\" \"|\" \"&\" \"<<\" \">>\" 55 | \"!\" \"||\" \"&&\" 56 | \"->\" 57 | \"==\" \"!=\" \"<\" \">\" \"<=\" \">=\" 58 | \"=\" \"+=\" \"-=\" \"*=\" \"/=\" \"%=\" \"|=\" \"&=\" 59 | \"++\" \"--\" 60 | ] @operator 61 | 62 | (conditional_expression [\"?\" \":\"] @operator) 63 | 64 | [\"(\" \")\" \"[\" \"]\" \"{\" \"}\"] @punctuation.bracket 65 | 66 | [\".\" \",\" \";\"] @punctuation.delimiter 67 | 68 | ;;; ---------------------------------------------------------------------------- 69 | ;;; Functions. 70 | 71 | (call_expression 72 | function: [(identifier) @function.call 73 | (field_expression field: (_) @method.call)]) 74 | 75 | (function_declarator 76 | declarator: [(identifier) @function 77 | (parenthesized_declarator 78 | (pointer_declarator (field_identifier) @function))]) 79 | 80 | (preproc_function_def 81 | name: (identifier) @function) 82 | 83 | ;;; ---------------------------------------------------------------------------- 84 | ;;; Types. 85 | 86 | [(primitive_type) 87 | (sized_type_specifier)] @type.builtin 88 | 89 | (type_identifier) @type 90 | 91 | ;;; ---------------------------------------------------------------------------- 92 | ;;; Variables. 93 | 94 | (declaration declarator: [(identifier) @variable 95 | (_ (identifier) @variable)]) 96 | 97 | (parameter_declaration declarator: [(identifier) @variable.parameter 98 | (_ (identifier) @variable.parameter)]) 99 | 100 | (init_declarator declarator: [(identifier) @variable 101 | (_ (identifier) @variable)]) 102 | 103 | (assignment_expression 104 | left: [(identifier) @variable 105 | (field_expression field: (_) @variable) 106 | (subscript_expression argument: (identifier) @variable) 107 | (pointer_expression (identifier) @variable)]) 108 | 109 | (update_expression 110 | argument: (identifier) @variable) 111 | 112 | (preproc_def name: (identifier) @variable.special) 113 | 114 | (preproc_params 115 | (identifier) @variable.parameter) 116 | 117 | ;;; ---------------------------------------------------------------------------- 118 | ;;; Properties. 119 | 120 | (field_declaration 121 | declarator: [(field_identifier) @property.definition 122 | (pointer_declarator (field_identifier) @property.definition) 123 | (pointer_declarator (pointer_declarator (field_identifier) @property.definition))]) 124 | 125 | (enumerator name: (identifier) @property.definition) 126 | 127 | (field_identifier) @property 128 | 129 | ;;; ---------------------------------------------------------------------------- 130 | ;;; Misc. 131 | 132 | ((identifier) @constant 133 | (.match? @constant \"^[A-Z_][A-Z_\\d]*$\")) 134 | 135 | [(null) (true) (false)] @constant.builtin 136 | 137 | [(number_literal) 138 | (char_literal)] @number 139 | 140 | (statement_identifier) @label 141 | 142 | ;;; ---------------------------------------------------------------------------- 143 | ;;; Strings and comments. 144 | 145 | (comment) @comment 146 | 147 | [(string_literal) 148 | (system_lib_string)] @string") 149 | 150 | (add-hook! c++-mode-hook 151 | (colambda () 152 | (set! (local-var 'tree-sitter:language) 153 | (tree-sitter-language-cpp)) 154 | (set! (local-var 'tree-sitter:highlight-patterns) 155 | tree-sitter-highlight-patterns-cpp) 156 | (tree-sitter-highlight-mode))) 157 | -------------------------------------------------------------------------------- /modules/zem/progmodes/prog-mode.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem progmodes prog-mode) 2 | #:use-module (zem core mode) 3 | #:use-module (emacsy emacsy) 4 | #:use-module (ice-9 regex) 5 | #:export (enter-prog-mode)) 6 | 7 | (define-derived-mode prog-mode fundamental-mode "Prog") 8 | -------------------------------------------------------------------------------- /modules/zem/syntax/tree-sitter.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem syntax tree-sitter) 2 | #:use-module (zem core buffer) 3 | #:use-module (zem core text-prop) 4 | #:use-module (zem core mode) 5 | #:use-module (zem core font-lock) 6 | #:use-module (zem progmodes cc-mode) 7 | #:use-module (ice-9 match) 8 | #:use-module (emacsy emacsy)) 9 | 10 | (load-extension "libguile-tree-sitter" "init_tree_sitter") 11 | 12 | (define* (position->ts-point #:optional (pos (point))) 13 | (save-excursion 14 | (goto-char pos) 15 | (cons (line-number-at-pos) (current-column)))) 16 | 17 | (define (ts-before-change start end) 18 | (let ((start-byte (position-bytes start)) 19 | (end-byte (position-bytes end)) 20 | (start-point (position->ts-point start)) 21 | (end-point (position->ts-point end))) 22 | (set! (local-var 'tree-sitter:before-change-point) (vector start-byte end-byte start-point end-point)))) 23 | 24 | (define (ts-after-change start end len) 25 | (match-let ((#(start-byte old-end-byte start-point old-end-point) 26 | (local-var 'tree-sitter:before-change-point))) 27 | (tree-edit (local-var 'tree-sitter:tree) 28 | start-byte 29 | old-end-byte 30 | (position-bytes end) 31 | start-point 32 | old-end-point 33 | (position->ts-point end)) 34 | (update-buffer (current-buffer)))) 35 | 36 | (define (highlight-query-capture-mapper name) 37 | (cond 38 | ((string= name "keyword") font-lock-keyword-face) 39 | ((string= name "number") font-lock-constant-face) 40 | ((string= name "string") font-lock-string-face) 41 | ((string= name "operator") font-lock-keyword-face) 42 | ((or 43 | (string= name "type") 44 | (string= name "type.builtin")) font-lock-type-face) 45 | ((or 46 | (string= name "function") 47 | (string= name "function.call")) font-lock-function-name-face) 48 | ((string= name "comment") font-lock-comment-face) 49 | ((string= name "function.macro") font-lock-preprocessor-face) 50 | (else 'default))) 51 | 52 | (define (ensure-highlight-query) 53 | (unless (local-var 'tree-sitter:highlight-query) 54 | (set! (local-var 'tree-sitter:highlight-query) 55 | (query-new (local-var 'tree-sitter:language) 56 | (local-var 'tree-sitter:highlight-patterns) 57 | highlight-query-capture-mapper))) 58 | (local-var 'tree-sitter:highlight-query)) 59 | 60 | (define-public (setup-buffer buffer) 61 | (with-buffer buffer 62 | (let* ((parser (parser-new (local-var 'tree-sitter:language))) 63 | (tree (parser-parse-string parser (buffer-string)))) 64 | (set! (local-var 'tree-sitter:parser) parser) 65 | (set! (local-var 'tree-sitter:tree) tree) 66 | (set! (local-var 'tree-sitter:query-cursor) (query-cursor-new)) 67 | (set! (local-var 'tree-sitter:highlight-query) #f) 68 | (ensure-highlight-query) 69 | (highlight-region buffer (point-min) (point-max)) 70 | (set! (local-var 'tree-sitter:before-change-point) #(0 0 (0 . 0) (0 . 0))) 71 | (add-hook! (local-var 'before-change-functions) ts-before-change) 72 | (add-hook! (local-var 'after-change-functions) ts-after-change)))) 73 | 74 | (define (invalidate-highlight old-tree) 75 | (let ((ranges (tree-changed-ranges old-tree (local-var 'tree-sitter:tree)))) 76 | (for-each (match-lambda 77 | ((beg . end) (highlight-region (current-buffer) beg (point-max)))) 78 | ranges))) 79 | 80 | 81 | (define-public (update-buffer buffer) 82 | (with-buffer buffer 83 | (let ((old-tree (local-var 'tree-sitter:tree))) 84 | (set! (local-var 'tree-sitter:tree) 85 | (parser-parse-string (local-var 'tree-sitter:parser) 86 | (buffer-string) 87 | (local-var 'tree-sitter:tree))) 88 | (invalidate-highlight old-tree)))) 89 | 90 | (define (highlight-capture capture) 91 | (match capture 92 | (((start . end) . face) 93 | (when (not (= start end)) 94 | (put-text-property start end 'face face))))) 95 | 96 | (define-public (highlight-region buffer beg end) 97 | (with-buffer buffer 98 | (let ((cursor (local-var 'tree-sitter:query-cursor)) 99 | (root (tree-root-node (local-var 'tree-sitter:tree)))) 100 | (query-cursor-set-byte-range cursor 101 | (position-bytes beg) 102 | (position-bytes end)) 103 | (let ((captures (query-cursor-captures 104 | cursor 105 | (local-var 'tree-sitter:highlight-query) 106 | root))) 107 | (for-each highlight-capture captures))))) 108 | 109 | (define-minor-mode tree-sitter-highlight-mode #f "TreeSitter-Hl" 110 | (font-lock-mode) 111 | (setup-buffer (current-buffer))) 112 | -------------------------------------------------------------------------------- /modules/zem/themes/doom-one.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem themes doom-one) 2 | #:use-module (zem core faces) 3 | #:use-module (zem ui style) 4 | #:use-module (zem themes theme)) 5 | 6 | (set! background-color #x282c34) 7 | 8 | (set-face-attribute 'default ':foreground #xf8f8f2) 9 | 10 | (define-face font-lock-keyword-face '((t :foreground #x51afef))) 11 | (define-face font-lock-string-face '((t :foreground #x98be65))) 12 | (define-face font-lock-type-face '((t :foreground #xecbe78))) 13 | (define-face font-lock-constant-face '((t :foreground #xda8548))) 14 | (define-face font-lock-function-name-face '((t :foreground #xa6e22e))) 15 | (define-face font-lock-comment-face '((t :foreground #x404040))) 16 | (define-face font-lock-preprocessor-face '((t :foreground #x51afef))) 17 | 18 | (define-face mode-line '((t :foreground #xf8f8f2 :background #x606060 :inherit fixed-pitch))) 19 | 20 | (define-face line-number '((t :foreground #x404040 :background #x202020 :inherit fixed-pitch))) 21 | 22 | (define-face cursor '((t :foreground #x808080))) 23 | 24 | (define-face scroll-bar '((t :foreground #x404040))) 25 | 26 | (define-face window-divider '((t :background #x0f0f0f))) 27 | 28 | (define-face highlight `((t :background ,(blend-color #x282c34 #x2257a0)))) 29 | 30 | (define-face region '((t :background #x2257a0))) 31 | -------------------------------------------------------------------------------- /modules/zem/themes/monokai.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem themes monokai) 2 | #:use-module (zem core faces) 3 | #:use-module (zem ui style)) 4 | 5 | (set! background-color #x272822) 6 | 7 | (set-face-attribute 'default ':foreground #xf8f8f2) 8 | 9 | (define-face font-lock-keyword-face '((t :foreground #xf92672))) 10 | (define-face font-lock-string-face '((t :foreground #xe6db74))) 11 | (define-face font-lock-type-face '((t :foreground #x66d9ef))) 12 | (define-face font-lock-constant-face '((t :foreground #xae81ff))) 13 | (define-face font-lock-function-name-face '((t :foreground #xa6e22e))) 14 | (define-face font-lock-comment-face '((t :foreground #x404040))) 15 | 16 | (define-face mode-line '((t :foreground #xf8f8f2 :background #x606060 :inherit fixed-pitch))) 17 | 18 | (define-face line-number '((t :foreground #x404040 :background #x202020 :inherit fixed-pitch))) 19 | 20 | (define-face cursor '((t :foreground #x808080))) 21 | 22 | (define-face scroll-bar '((t :foreground #x404040))) 23 | 24 | (define-face window-divider '((t :background #x0f0f0f))) 25 | 26 | (define-face highlight '((t :background #x333428))) 27 | 28 | (define-face region '((t :background #x414236))) 29 | -------------------------------------------------------------------------------- /modules/zem/themes/theme.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem themes theme)) 2 | 3 | (define (color-value->rgb color) 4 | (map (lambda (i) (logand #xff (ash color (- (* i 8))))) '(2 1 0))) 5 | 6 | (define (rgb->color-value rgb) 7 | (apply logior (map (lambda (v i) (ash v (* i 8))) rgb '(2 1 0)))) 8 | 9 | (define-public (blend-color a b) 10 | (let ((rgba (color-value->rgb a)) 11 | (rgbb (color-value->rgb b))) 12 | (rgb->color-value 13 | (map (lambda (a b) (inexact->exact (floor (/ (+ a b) 2)))) rgba rgbb)))) 14 | 15 | (define-public (darken-color a f) 16 | (rgb->color-value 17 | (map (lambda (v) (inexact->exact (floor (* v (- 1.0 f))))) (color-value->rgb a)))) 18 | 19 | (define-public (lighten-color a f) 20 | (rgb->color-value 21 | (map (lambda (v) (inexact->exact (floor (* v (+ 1.0 f))))) (color-value->rgb a)))) 22 | -------------------------------------------------------------------------------- /modules/zem/ui/minibuffer-view.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem ui minibuffer-view) 2 | #:use-module ((zem api font) #:prefix f:) 3 | #:use-module ((zem api renderer) #:prefix r:) 4 | #:use-module (zem core faces) 5 | #:use-module (zem ui view) 6 | #:use-module ((zem ui style) #:prefix style:) 7 | #:use-module (emacsy emacsy) 8 | #:use-module (ice-9 match) 9 | #:use-module (oop goops) 10 | #:export ()) 11 | 12 | (define-class () 13 | (prompt #:init-form "" #:accessor minibuffer-view:prompt) 14 | (message #:init-form "" #:accessor minibuffer-view:message)) 15 | 16 | (define (get-text-y-offset) 17 | (floor (/ (f:get-font-height (face-attribute 'default ':font)) 4.0))) 18 | 19 | (define-method (view:draw (view )) 20 | (match-let* (((x . y) (view:pos view)) 21 | ((w . h) (view:size view)) 22 | (font (face-attribute 'default ':font)) 23 | (foreground (face-attribute 'default ':foreground)) 24 | (prompt (minibuffer-view:prompt view)) 25 | (prompt-foreground (face-attribute 'minibuffer-prompt ':foreground))) 26 | (draw-view-background view style:background-color) 27 | (r:add-text font 28 | (cons (+ x (car style:padding)) (+ y (f:get-font-height font))) 29 | (string-append 30 | (make-string (string-length prompt) #\ ) 31 | (minibuffer-view:message view)) 32 | foreground 33 | (- w (car style:padding))) 34 | (r:add-text font 35 | (cons (+ x (car style:padding)) (+ y (f:get-font-height font))) 36 | prompt 37 | prompt-foreground 38 | (- w (car style:padding))))) 39 | 40 | (define-method (view:get-size-request (view )) 41 | (set! (minibuffer-view:prompt view) (minibuffer-prompt minibuffer)) 42 | (set! (minibuffer-view:message view) (string-append 43 | (minibuffer-contents minibuffer) 44 | (minibuffer-message-string minibuffer))) 45 | (match-let (((w . h) (r:text-size-hint (face-attribute 'default ':font) 46 | (string-append 47 | (minibuffer-view:prompt view) 48 | (minibuffer-view:message view)) 49 | (- (car (view:size view)) 50 | (* 2 (car style:padding)))))) 51 | (cons w (+ h (get-text-y-offset))))) 52 | -------------------------------------------------------------------------------- /modules/zem/ui/style.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem ui style) 2 | #:declarative? #f) 3 | 4 | (define-public padding '(7 . 7)) 5 | 6 | (define-public background-color 0) 7 | 8 | (define-public divider-size 1) 9 | (define-public scrollbar-size 6) 10 | (define-public caret-width 2) 11 | -------------------------------------------------------------------------------- /modules/zem/ui/view.scm: -------------------------------------------------------------------------------- 1 | (define-module (zem ui view) 2 | #:use-module ((zem api renderer) #:prefix r:) 3 | #:use-module (ice-9 match) 4 | #:use-module (oop goops) 5 | #:export ( 6 | view:pos 7 | view:size 8 | view:active? 9 | view:cursor 10 | view:scroll 11 | view:scroll-target 12 | view:draw 13 | view:update 14 | view:draw 15 | view:get-size-request 16 | view:get-visible-bbox 17 | view:get-scroll-limit 18 | view:mouse-position-callback 19 | view:mouse-press-callback 20 | view:mouse-release-callback 21 | view:mouse-scroll-callback)) 22 | 23 | (define-class () 24 | (pos #:init-keyword #:pos #:init-form '(0 . 0) #:accessor view:pos) 25 | (size #:init-keyword #:size #:init-form '(0 . 0) #:accessor view:size) 26 | (active? #:init-value #f #:accessor view:active?) 27 | (cursor #:init-value 'arrow #:accessor view:cursor) 28 | (scroll #:init-form '(0 . 0) #:accessor view:scroll) 29 | (scroll-target #:init-form '(0 . 0) #:accessor view:scroll-target)) 30 | 31 | (define-public (update-view-layout view pos size) 32 | (set! (view:pos view) pos) 33 | (set! (view:size view) size)) 34 | 35 | (define (clamp-scroll-offset view scroll) 36 | (cons (car scroll) (min (max 0 (cdr scroll)) (view:get-scroll-limit view)))) 37 | 38 | (define-method (view:update (view ) delta) 39 | (when (not (equal? (view:scroll-target view) (view:scroll view))) 40 | (set! (view:scroll-target view) 41 | (clamp-scroll-offset view (view:scroll-target view))) 42 | (set! (view:scroll view) (view:scroll-target view)))) 43 | 44 | (define-method (view:draw (view ))) 45 | 46 | (define-method (view:get-size-request (view )) 47 | (view:size view)) 48 | 49 | (define-method (view:get-visible-bbox (view )) 50 | (match-let (((sx . sy) (view:scroll view)) 51 | ((w . h) (view:size view))) 52 | (list sx sy (+ sx w) (+ sy h)))) 53 | 54 | (define-method (view:get-scroll-limit (view )) 55 | +inf.0) 56 | 57 | (define-method (view:mouse-position-callback (view ) x y) 58 | #f) 59 | 60 | (define-public mouse-scroll-factor 50) 61 | 62 | (define-method (view:mouse-press-callback (view ) button x y) 63 | #f) 64 | 65 | (define-method (view:mouse-release-callback (view ) button) 66 | #f) 67 | 68 | (define-method (view:mouse-scroll-callback (view ) y-offset) 69 | (match-let (((sx . sy) (view:scroll-target view))) 70 | (set! (view:scroll-target view) (cons sx (- sy (* y-offset mouse-scroll-factor)))))) 71 | 72 | (define-public (draw-view-background view color) 73 | (r:add-rect (view:pos view) (view:size view) color)) 74 | -------------------------------------------------------------------------------- /modules/zem/util/plist.scm: -------------------------------------------------------------------------------- 1 | ;;; lists.scm --- Property lists 2 | 3 | ;; Copyright © 2015 Alex Kost 4 | 5 | ;; Author: Alex Kost 6 | ;; Created: 12 Apr 2015 7 | 8 | ;; This program is free software; you can redistribute it and/or modify 9 | ;; it under the terms of the GNU General Public License as published by 10 | ;; the Free Software Foundation, either version 3 of the License, or 11 | ;; (at your option) any later version. 12 | 13 | ;; This program is distributed in the hope that it will be useful, 14 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 15 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 | ;; GNU General Public License for more details. 17 | 18 | ;; You should have received a copy of the GNU General Public License 19 | ;; along with this program. If not, see . 20 | 21 | ;;; Commentary: 22 | 23 | ;; This file provides procedures for working with property lists. 24 | ;; 25 | ;; Property list is a list of the form: 26 | ;; 27 | ;; (PROP1 VALUE1 PROP2 VALUE2 ...) 28 | ;; 29 | ;; PROP1, PROP2, ... - symbols or keywords. 30 | ;; VALUE1, VALUE2, ... - any objects. 31 | 32 | ;;; Examples: 33 | 34 | ;; (plist-get '(one 1 two 2 three 3) 'two) => 2 35 | ;; (plist-get '(one 1 two 2 three 3) 'four) => #f 36 | ;; (plist-get '(foo bar bar zoo) 'bar) => zoo 37 | ;; 38 | ;; (plist-delete '(#:foo a #:bar b baz c #:bar d) #:bar) 39 | ;; => (baz c #:foo a) 40 | ;; 41 | ;; (plist-put '(foo 1 bar two) 'bar 2) => (bar 2 foo 1) 42 | ;; (plist-put '(foo 1 bar 2) 'baz 3) => (baz 3 foo 1 bar 2) 43 | ;; 44 | ;; (plist-new '(#:foo "one" #:bar "two" baz 3) 45 | ;; 'baz "three" 46 | ;; 'foo "oof" 47 | ;; #:bar 'bar) 48 | ;; => (#:bar bar foo "oof" baz "three" #:foo "one") 49 | 50 | ;;; Code: 51 | 52 | (define-module (zem util plist) 53 | #:use-module (ice-9 match) 54 | #:export (plist-fold 55 | plist-get 56 | plist-add 57 | plist-delete 58 | plist-put 59 | plist-new)) 60 | 61 | (define (plist-fold proc init plist) 62 | "Fold over property/value elements of PLIST. 63 | Call (PROC PROPERTY VALUE RESULT) for each property, using INIT as the 64 | initial value of RESULT." 65 | (let loop ((result init) 66 | (current plist)) 67 | (match current 68 | (() 69 | result) 70 | ((prop val rest ...) 71 | (loop (proc prop val result) 72 | rest))))) 73 | 74 | (define (plist-get plist property) 75 | "Return a value of PROPERTY from PLIST. 76 | Return #f if PROPERTY does not exist." 77 | (match plist 78 | ((prop val rest ...) 79 | (if (eq? prop property) 80 | val 81 | (plist-get rest property))) 82 | (_ #f))) 83 | 84 | (define (plist-add plist property value) 85 | "Add PROPERTY/VALUE pair to PLIST." 86 | (cons* property value plist)) 87 | 88 | (define (plist-delete plist property) 89 | "Remove all PROPERTY elements from PLIST." 90 | (plist-fold (lambda (prop val res) 91 | (if (eq? prop property) 92 | res 93 | (plist-add res prop val))) 94 | '() 95 | plist)) 96 | 97 | (define (plist-put plist property value) 98 | "Return new plist by changing or adding PROPERTY/VALUE pair in PLIST." 99 | (plist-add (plist-delete plist property) 100 | property value)) 101 | 102 | (define (plist-new old-plist . add-plist) 103 | "Return new plist by adding property/value pairs from ADD-PLIST to 104 | OLD-PLIST." 105 | (plist-fold (lambda (prop val res) 106 | (plist-put res prop val)) 107 | old-plist 108 | add-plist)) 109 | 110 | ;;; lists.scm ends here 111 | -------------------------------------------------------------------------------- /run.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | export GUILE_LOAD_PATH=`realpath ../modules`:$GUILE_LOAD_PATH 4 | export LD_LIBRARY_PATH=`realpath lib/`:$LD_LIBRARY_PATH 5 | 6 | bin/zem 7 | -------------------------------------------------------------------------------- /src/api/api.cpp: -------------------------------------------------------------------------------- 1 | namespace zem { 2 | 3 | extern void init_renderer_api(); 4 | extern void init_font_api(); 5 | extern void init_rope_api(); 6 | 7 | void init_api() 8 | { 9 | init_renderer_api(); 10 | init_font_api(); 11 | init_rope_api(); 12 | } 13 | 14 | } // namespace zem 15 | -------------------------------------------------------------------------------- /src/api/font.cpp: -------------------------------------------------------------------------------- 1 | #include "font.h" 2 | 3 | #include 4 | #include 5 | 6 | namespace zem { 7 | 8 | static SCM font_type; 9 | 10 | static SCM zem_font_load_font(SCM s_name, SCM s_size) 11 | { 12 | Font* font; 13 | void* ptr; 14 | std::unique_ptr name; 15 | name.reset(scm_to_locale_string(s_name)); 16 | 17 | ptr = scm_gc_malloc(sizeof(*font), "font"); 18 | font = new (ptr) Font(std::string(name.get()), scm_to_uint(s_size)); 19 | 20 | return scm_make_foreign_object_1(font_type, font); 21 | } 22 | 23 | static SCM zem_font_get_font_height(SCM s_font) 24 | { 25 | Font* font = (Font*)scm_foreign_object_ref(s_font, 0); 26 | 27 | return scm_from_uint(font->get_height_pixels()); 28 | } 29 | 30 | static void finalize_font(SCM s_font) 31 | { 32 | Font* font = (Font*)scm_foreign_object_ref(s_font, 0); 33 | font->~Font(); 34 | } 35 | 36 | static void zem_api_font_init(void* data) 37 | { 38 | SCM name, slots; 39 | scm_t_struct_finalize finalizer; 40 | 41 | name = scm_from_utf8_symbol("font"); 42 | slots = scm_list_1(scm_from_utf8_symbol("data")); 43 | 44 | font_type = scm_make_foreign_object_type(name, slots, finalize_font); 45 | 46 | scm_c_define_gsubr("load-font", 2, 0, 0, (void*)zem_font_load_font); 47 | scm_c_define_gsubr("get-font-height", 1, 0, 0, 48 | (void*)zem_font_get_font_height); 49 | 50 | scm_c_export("load-font", "get-font-height", NULL); 51 | } 52 | 53 | void init_font_api() 54 | { 55 | scm_c_define_module("zem api font", zem_api_font_init, nullptr); 56 | } 57 | 58 | } // namespace zem 59 | -------------------------------------------------------------------------------- /src/api/renderer.cpp: -------------------------------------------------------------------------------- 1 | #include "renderer.h" 2 | 3 | #include 4 | 5 | namespace zem { 6 | 7 | static Vector2 extract_vec2(SCM val) 8 | { 9 | float x = scm_to_double(scm_car(val)); 10 | float y = scm_to_double(scm_cdr(val)); 11 | return Vector2{x, y}; 12 | } 13 | 14 | static ColorValue extract_color(SCM val) 15 | { 16 | return ColorValue::from_u32(scm_to_uint32(val)); 17 | } 18 | 19 | static SCM zem_renderer_add_rect(SCM s_pos, SCM s_size, SCM s_color) 20 | { 21 | Vector2 pos = extract_vec2(s_pos); 22 | Vector2 size = extract_vec2(s_size); 23 | ColorValue color = extract_color(s_color); 24 | 25 | RENDERER.add_rect(pos, pos + size, color); 26 | 27 | return SCM_UNSPECIFIED; 28 | } 29 | 30 | static SCM zem_renderer_add_text(SCM s_font, SCM s_pos, SCM s_text, SCM s_color, 31 | SCM s_max_width) 32 | { 33 | Font* font = (Font*)scm_foreign_object_ref(s_font, 0); 34 | Vector2 pos = extract_vec2(s_pos), new_pos; 35 | ColorValue color = extract_color(s_color); 36 | std::unique_ptr text; 37 | float max_width = 0; 38 | 39 | text.reset(scm_to_locale_string(s_text)); 40 | if (s_max_width != SCM_UNDEFINED) max_width = scm_to_double(s_max_width); 41 | 42 | new_pos = 43 | RENDERER.add_text(font, pos, std::string(text.get()), color, max_width); 44 | 45 | return scm_cons(scm_from_double(new_pos.x), scm_from_double(new_pos.y)); 46 | } 47 | 48 | static SCM zem_renderer_text_size_hint(SCM s_font, SCM s_text, SCM s_max_width) 49 | { 50 | Font* font = (Font*)scm_foreign_object_ref(s_font, 0); 51 | Vector2 size; 52 | std::unique_ptr text; 53 | float max_width = 0; 54 | 55 | text.reset(scm_to_locale_string(s_text)); 56 | if (s_max_width != SCM_UNDEFINED) max_width = scm_to_double(s_max_width); 57 | 58 | size = RENDERER.text_size_hint(font, std::string(text.get()), max_width); 59 | 60 | return scm_cons(scm_from_double(size.x), scm_from_double(size.y)); 61 | } 62 | 63 | static SCM zem_renderer_char_offset(SCM s_font, SCM s_text, SCM s_x_offset) 64 | { 65 | Font* font = (Font*)scm_foreign_object_ref(s_font, 0); 66 | unsigned int offset; 67 | std::unique_ptr text; 68 | float x_offset = 0; 69 | 70 | text.reset(scm_to_locale_string(s_text)); 71 | x_offset = scm_to_double(s_x_offset); 72 | 73 | offset = RENDERER.char_offset(font, std::string(text.get()), x_offset); 74 | 75 | return scm_from_uint(offset); 76 | } 77 | 78 | static SCM zem_renderer_push_clip_rect(SCM s_pos, SCM s_size) 79 | { 80 | Vector2 pos = extract_vec2(s_pos); 81 | Vector2 size = extract_vec2(s_size); 82 | 83 | RENDERER.push_clip_rect(pos, size); 84 | 85 | return SCM_UNSPECIFIED; 86 | } 87 | 88 | static SCM zem_renderer_pop_clip_rect() 89 | { 90 | RENDERER.pop_clip_rect(); 91 | return SCM_UNSPECIFIED; 92 | } 93 | 94 | void zem_api_renderer_init(void* data) 95 | { 96 | scm_c_define_gsubr("add-rect", 3, 0, 0, (void*)zem_renderer_add_rect); 97 | scm_c_define_gsubr("add-text", 4, 1, 0, (void*)zem_renderer_add_text); 98 | scm_c_define_gsubr("text-size-hint", 2, 1, 0, 99 | (void*)zem_renderer_text_size_hint); 100 | scm_c_define_gsubr("char-offset", 3, 0, 0, (void*)zem_renderer_char_offset); 101 | scm_c_define_gsubr("push-clip-rect", 2, 0, 0, 102 | (void*)zem_renderer_push_clip_rect); 103 | scm_c_define_gsubr("pop-clip-rect", 0, 0, 0, 104 | (void*)zem_renderer_pop_clip_rect); 105 | scm_c_export("add-rect", "add-text", "text-size-hint", "push-clip-rect", 106 | "pop-clip-rect", "char-offset", NULL); 107 | } 108 | 109 | void init_renderer_api() 110 | { 111 | scm_c_define_module("zem api renderer", zem_api_renderer_init, nullptr); 112 | } 113 | 114 | } // namespace zem 115 | -------------------------------------------------------------------------------- /src/font.cpp: -------------------------------------------------------------------------------- 1 | #include "font.h" 2 | 3 | #include 4 | 5 | #include "spdlog/spdlog.h" 6 | #include 7 | 8 | namespace zem { 9 | 10 | struct FTLibrary { 11 | FT_Library ft; 12 | 13 | FTLibrary() { FT_Init_FreeType(&ft); } 14 | ~FTLibrary() { FT_Done_FreeType(ft); } 15 | }; 16 | 17 | static thread_local FTLibrary g_ft; 18 | 19 | Font::Font(const std::string& filename, unsigned int size_pixels) 20 | : filename(filename), size_pixels(size_pixels) 21 | { 22 | if (FT_New_Face(g_ft.ft, filename.c_str(), 0, &face)) { 23 | spdlog::error("Failed to load font '{}'", filename); 24 | return; 25 | } 26 | 27 | FT_Select_Charmap(face, FT_ENCODING_UNICODE); 28 | 29 | FT_Set_Pixel_Sizes(face, 0, size_pixels); 30 | } 31 | 32 | Font::~Font() { FT_Done_Face(face); } 33 | 34 | unsigned int Font::get_height_pixels() const 35 | { 36 | return face->size->metrics.height >> 6; 37 | } 38 | 39 | std::tuple Font::find_glyph(uint32_t codepoint) 40 | { 41 | unsigned atlas_idx = codepoint >> 8; 42 | 43 | auto iter = atlas_set.find(atlas_idx); 44 | if (iter == atlas_set.end()) { 45 | FontAtlas new_atlas; 46 | load_atlas(atlas_idx, new_atlas); 47 | iter = atlas_set.insert({atlas_idx, new_atlas}).first; 48 | } 49 | 50 | auto& atlas = iter->second; 51 | 52 | return std::tie(atlas.glyphs[codepoint & 0xff], atlas.tex_id); 53 | } 54 | 55 | void Font::load_atlas(unsigned int idx, FontAtlas& atlas) 56 | { 57 | std::unique_ptr buf; 58 | 59 | unsigned int max_dim = (1 + (face->size->metrics.height >> 6)) * 60 | ceilf(sqrtf(FontAtlas::GLYPH_COUNT)); 61 | unsigned int tex_width = 1; 62 | while (tex_width < max_dim) 63 | tex_width <<= 1; 64 | unsigned int tex_height = tex_width; 65 | 66 | buf = std::make_unique(tex_width * tex_height * 4); 67 | unsigned int u, v; 68 | u = v = 0; 69 | 70 | for (int i = 0; i < FontAtlas::GLYPH_COUNT; i++) { 71 | unsigned long glyph_idx = FT_Get_Char_Index(face, (idx << 8) | i); 72 | if (!glyph_idx) continue; 73 | 74 | if (FT_Load_Glyph(face, glyph_idx, 0)) continue; 75 | if (FT_Render_Glyph(face->glyph, FT_RENDER_MODE_NORMAL)) continue; 76 | 77 | FT_Bitmap& bmp = face->glyph->bitmap; 78 | 79 | if (u + bmp.width >= tex_width) { 80 | u = 0; 81 | v += ((face->size->metrics.height >> 6) + 1); 82 | } 83 | 84 | for (int row = 0; row < bmp.rows; ++row) { 85 | for (int col = 0; col < bmp.width; ++col) { 86 | int x = u + col; 87 | int y = v + row; 88 | 89 | buf[((y * tex_width + x) << 2) + 0] = 255; 90 | buf[((y * tex_width + x) << 2) + 1] = 255; 91 | buf[((y * tex_width + x) << 2) + 2] = 255; 92 | buf[((y * tex_width + x) << 2) + 3] = 93 | bmp.buffer[row * bmp.pitch + col]; 94 | } 95 | } 96 | 97 | auto& glyph = atlas.glyphs[i]; 98 | 99 | glyph.x0 = face->glyph->bitmap_left; 100 | glyph.y0 = -face->glyph->bitmap_top; 101 | glyph.x1 = glyph.x0 + bmp.width; 102 | glyph.y1 = glyph.y0 + bmp.rows; 103 | 104 | glyph.u0 = u / (float)tex_width; 105 | glyph.v0 = v / (float)tex_height; 106 | glyph.u1 = (u + bmp.width) / (float)tex_width; 107 | glyph.v1 = (v + bmp.rows) / (float)tex_height; 108 | 109 | glyph.x_advance = face->glyph->advance.x >> 6; 110 | 111 | u += bmp.width + 1; 112 | } 113 | 114 | GLuint texture; 115 | glGenTextures(1, &texture); 116 | glBindTexture(GL_TEXTURE_2D, texture); 117 | glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); 118 | glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); 119 | glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, tex_width, tex_height, 0, GL_RGBA, 120 | GL_UNSIGNED_BYTE, buf.get()); 121 | glBindTexture(GL_TEXTURE_2D, 0); 122 | 123 | atlas.tex_id = texture; 124 | atlas.tex_width = tex_width; 125 | atlas.tex_height = tex_height; 126 | } 127 | 128 | } // namespace zem 129 | -------------------------------------------------------------------------------- /src/intern_string.cpp: -------------------------------------------------------------------------------- 1 | #include "intern_string.h" 2 | 3 | #include 4 | #include 5 | 6 | namespace zem { 7 | 8 | namespace detail { 9 | 10 | using StringKey = std::string; 11 | 12 | static std::unordered_map> 14 | intern_pool; 15 | 16 | } // namespace detail 17 | 18 | detail::InternStringDetail* InternString::intern(const char* str, size_t len) 19 | { 20 | detail::StringKey key(str, str + len); 21 | auto iter = detail::intern_pool.find(key); 22 | 23 | if (iter != detail::intern_pool.end()) { 24 | return iter->second.get(); 25 | } 26 | 27 | std::shared_ptr interned( 28 | new detail::InternStringDetail(str, len)); 29 | detail::intern_pool[key] = interned; 30 | return interned.get(); 31 | } 32 | 33 | } // namespace zem 34 | -------------------------------------------------------------------------------- /src/keymap.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include "keymap.h" 4 | 5 | /* clang-format off */ 6 | 7 | const int zem_keymap[256][1] = { 8 | [GLFW_KEY_1] = {'!'}, 9 | [GLFW_KEY_2] = {'@'}, 10 | [GLFW_KEY_3] = {'#'}, 11 | [GLFW_KEY_4] = {'$'}, 12 | [GLFW_KEY_5] = {'%'}, 13 | [GLFW_KEY_6] = {'^'}, 14 | [GLFW_KEY_7] = {'&'}, 15 | [GLFW_KEY_8] = {'*'}, 16 | [GLFW_KEY_9] = {'('}, 17 | [GLFW_KEY_0] = {')'}, 18 | [GLFW_KEY_MINUS] = {'_'}, 19 | [GLFW_KEY_EQUAL] = {'+'}, 20 | [GLFW_KEY_LEFT_BRACKET] = {'{'}, 21 | [GLFW_KEY_RIGHT_BRACKET] = {'}'}, 22 | [GLFW_KEY_BACKSLASH] = {'|'}, 23 | [GLFW_KEY_SEMICOLON] = {':'}, 24 | [GLFW_KEY_APOSTROPHE] = {'"'}, 25 | [GLFW_KEY_COMMA] = {'<'}, 26 | [GLFW_KEY_PERIOD] = {'>'}, 27 | [GLFW_KEY_SLASH] = {'?'}, 28 | }; 29 | 30 | /* clang-format on */ 31 | --------------------------------------------------------------------------------