From 770e262a44bc0cc58ba0774b965cacb0771d972f Mon Sep 17 00:00:00 2001 From: Taylor Skidmore Date: Wed, 25 Nov 2020 17:28:15 -0500 Subject: [PATCH] init commit --- README.org | 42 +++ local/gerbil-mode/gerbil-mode.el | 537 +++++++++++++++++++++++++++++++ packages.el | 76 +++++ 3 files changed, 655 insertions(+) create mode 100644 README.org create mode 100644 local/gerbil-mode/gerbil-mode.el create mode 100644 packages.el diff --git a/README.org b/README.org new file mode 100644 index 0000000..86d3e87 --- /dev/null +++ b/README.org @@ -0,0 +1,42 @@ +#+TITLE: gerbil layer +# Document tags are separated with "|" char +# The example below contains 2 tags: "layer" and "web service" +# Avaliable tags are listed in /.ci/spacedoc-cfg.edn +# under ":spacetools.spacedoc.config/valid-tags" section. +#+TAGS: layer|web service + +# The maximum height of the logo should be 200 pixels. +[[img/gerbil.png]] + +# TOC links should be GitHub style anchors. +* Table of Contents :TOC_4_gh:noexport: +- [[#description][Description]] + - [[#features][Features:]] +- [[#install][Install]] +- [[#key-bindings][Key bindings]] + +* Description +This layer adds support for something. + +** Features: + - Autocomplete + - Lint + - Refactor + - ... + +* Install +To use this configuration layer, add it to your =~/.spacemacs=. You will need to +add =gerbil= to the existing =dotspacemacs-configuration-layers= list in this +file. + +* Key bindings + +| Key Binding | Description | +|-------------+----------------| +| ~SPC x x x~ | Does thing01 | + +# Use GitHub URLs if you wish to link a Spacemacs documentation file or its heading. +# Examples: +# [[https://github.com/syl20bnr/spacemacs/blob/master/doc/VIMUSERS.org#sessions]] +# [[https://github.com/syl20bnr/spacemacs/blob/master/layers/%2Bfun/emoji/README.org][Link to Emoji layer README.org]] +# If space-doc-mode is enabled, Spacemacs will open a local copy of the linked file. diff --git a/local/gerbil-mode/gerbil-mode.el b/local/gerbil-mode/gerbil-mode.el new file mode 100644 index 0000000..f0f98fe --- /dev/null +++ b/local/gerbil-mode/gerbil-mode.el @@ -0,0 +1,537 @@ +;;; gerbil-mode.el --- Gerbil mode -*- lexical-binding: t; -*- +;; +;; Copyright (c) 2007-2019 Dimitris Vyzovitis & Contributors +;; +;; Author: Dimitris Vyzovitis +;; URL: https://github.com/vyzo/gerbil +;; Version: 1.0 +;; Keywords: gerbil major-mode +;; +;; This file is not part of GNU Emacs. +;; +;; This program is free software: you can redistribute it and/or modify it +;; under the terms of the GNU Lesser General Public License as published by +;; the Free Software Foundation, either version 2.1 of the License, or (at +;; your option) any later version; and the Apache License, Version 2.0 (the +;; "License"), as published by the Apache Sofware Fundation (ASF). +;; +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser +;; General Public License for more details. +;; +;; You should have received a copy of the GNU Lesser General Public License +;; and the Apache License along with this program. If not, see +;; and +;; . +;; +;; Unless required by applicable law or agreed to in writing, software +;; distributed under the License is distributed on an "AS IS" BASIS, +;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +;; See the License for the specific language governing permissions and +;; limitations under the License. + +;;; Commentary: +;; +;; This package provides a Gerbil major mode for Emacs. It extends +;; scheme-mode with font-lock, indentation, runs gxi on an inferior scheme +;; shell, and defines the following keybindings: +;; +;; * Compile the current buffer: `C-c C-f' +;; +;; * Import the current buffer: `C-c C-i' +;; +;; * Reload the current buffer: `C-c C-r' +;; +;; * Build the current project: `C-c C-b' +;; +;; * Send and evaluate the selected region to gxi: `C-c C-e' +;; +;; * Send the selected region to gxi: `C-c C-c' +;; +;; * Restart Scheme: `C-x 9' (also works in gxi) + +;;; Code: + +(require 'scheme) +(require 'cmuscheme) + +(defgroup gerbil-mode nil + "Editing Gerbil code" + :prefix "gerbil-mode-" + :group 'scheme) + +;; Redefine the function scheme-send-region from `cmuscheme' so +;; that we can keep track of all text sent to Gambit's stdin. +;; By Christopher Eames (Chream) 2018. + +(defun scheme-send-region (start end) + "Send the current region to the inferior Scheme process." + (interactive "r") + (scheme-send-string (buffer-substring start end))) + +(defun scheme-send-string (str) + "Send a string to the inferior Scheme process." + (gerbil-send-string str)) + +(defun gerbil-message (string) + (message (concat "Gerbil-info : SENT=" string " ..."))) + +(defun gerbil-send-string (string) + (let ((string (concat string "\n"))) + (comint-check-source string) + (comint-send-string (scheme-proc) string) + (gerbil-message (seq-subseq string 0 (string-match "\n" string))))) + +;; ------- + +;; fare's erlang style restart +(defun restart-scheme () + (interactive) + (let ((process (scheme-get-process))) + (when process + (ignore-errors + (switch-to-buffer "*scheme*") + (comint-clear-buffer)) + (ignore-errors (kill-process process)) + (sleep-for 1))) ;; <-- poor man's substitute for waitpid(), with a race condition + ;; TODO: elisp doesn't have a synchronous waitpid, so instead we should implement an asynchronous one, + ;; using callbacks: use (set-process-sentinel PROCESS SENTINEL) to watch for the death of the process; + ;; and while we're at it, also set a timer and use kill -9 < https://youtu.be/Fow7iUaKrq4 > + ;; if the process failed to die after one second or two. + (switch-to-buffer "*scheme*") + (run-scheme scheme-program-name) + (ignore-errors (comint-clear-buffer)) + (message "Happy Happy Joy Joy") + nil) + +;; this is bound to C-x 9 below + +;; ------- + +(defun gerbil-import-file (fname) + (let ((string (concat "(import \"" fname "\")\n"))) + (comint-check-source fname) + (comint-send-string + (scheme-proc) + string) + (gerbil-message string))) + +(defun gerbil-reload-file (fname) + (let ((string (concat "(reload \"" fname "\")\n"))) + (comint-check-source fname) + (comint-send-string + (scheme-proc) + string) + (gerbil-message string))) + +(defun gerbil-import-current-buffer () + (interactive) + (gerbil-import-file buffer-file-name)) + +(defun gerbil-reload-current-buffer () + (interactive) + (gerbil-reload-file buffer-file-name)) + +(defvar gerbil-compile-optimize t) +(defvar gerbil-build-directory nil) +(defvar gerbil-compiler-name "gxc") + +(defun gerbil-compile-current-buffer () + (interactive) + (let* ((fname buffer-file-name) + (buf (get-buffer-create "*gerbil-compile*")) + (cmd-text (concat "> gxc " (if gerbil-compile-optimize "-O " "") fname "\n"))) + (with-current-buffer buf + (goto-char (point-max)) + (insert cmd-text)) + (message cmd-text) + (setq gerbil-build-directory nil) + (let ((proc + (apply 'start-process gerbil-compiler-name buf + gerbil-compiler-name + (append (if gerbil-compile-optimize '("-O") '()) + (list fname))))) + (set-process-sentinel proc 'gerbil-compile-sentinel) + (display-buffer buf)))) + +(defun gerbil-build () + (interactive) + (let* ((dir (file-name-directory buffer-file-name)) + (build (gerbil-find-build-script dir)) + (build-dir (file-name-directory build)) + (build-script (file-name-nondirectory build)) + (buf (get-buffer-create "*gerbil-compile*"))) + (with-current-buffer buf + (goto-char (point-max)) + (insert "> build " build "\n")) + (setq gerbil-build-directory build-dir) + (let ((proc (start-process "build" buf "sh" "-c" + (concat "cd " build-dir " && ./" build-script)))) + (set-process-sentinel proc 'gerbil-compile-sentinel) + (display-buffer buf)))) + +(defun gerbil-find-build-script (dir) + (let ((files (directory-files dir nil "^build.ss$"))) + (cond + (files + (concat dir (car files))) + ((equal dir "/") + (error "Cannot locate build script")) + (t + (let ((dir (file-name-directory (directory-file-name dir)))) + (gerbil-find-build-script dir)))))) + +(defvar gerbil-compile-mark-rx + "^> \\(gxc\\|build\\)") +(defvar gerbil-error-locat-rx + "\\(\\\"\\(\\\\\\\\\\|\\\\\"\\|[^\\\"\n]\\)+\\\"\\)@\\([0-9]+\\)\\.\\([0-9]+\\)[^0-9]") + +(defun gerbil-compile-sentinel (proc evt) + (let ((buf (process-buffer proc))) + (when buf + (cond + ((equal evt "finished\n") + (kill-buffer buf)) + ((or (string-prefix-p "exited" evt) + (string-prefix-p "failed" evt)) + (with-current-buffer buf + (goto-char (point-max)) + (when (re-search-backward gerbil-compile-mark-rx nil t) + (let ((limit (point))) + (goto-char (point-max)) + (when (re-search-backward gerbil-error-locat-rx limit t) + (let* ((loc (gerbil-extract-locat (buffer-substring (point) (point-max)))) + (fname (if gerbil-build-directory + (concat gerbil-build-directory (car loc)) + (car loc)))) + (find-file fname) + (goto-char (point-min)) + (forward-line (1- (cadr loc))) + (forward-char (- (caddr loc) 1)) + (mark-sexp))))))) + (t + (with-current-buffer buf + (goto-char (point-max)) + (insert "\nProcess " evt))))))) + +(defun gerbil-extract-locat (str) + (and (string-match gerbil-error-locat-rx str) + (let* ((name (substring str + (match-beginning 1) + (match-end 1))) + (line (substring str + (match-beginning 3) + (match-end 3))) + (col (substring str + (match-beginning 4) + (match-end 4)))) + (list (read name) (read line) (read col))))) + +(defun gerbil-put (syms prop v) + (dolist (x syms) + (put x prop v))) + +(defun gerbil-put-indent (syms v) + (gerbil-put syms 'scheme-indent-function v)) + +(defun gerbil-fontlock-add (x) + (font-lock-add-keywords nil (list x) t)) + +(defun gerbil-init-keywords () + (interactive) + (gerbil-put '(import export declare include + or and + case-lambda + call/cc call/values + begin-syntax + begin-foreign + cond-expand + for-each map foldl foldr + unwind-protect + ) + 'scheme-indent-function 0) + + (gerbil-put '(if when unless + set! + begin-annotation begin0 + datum->syntax syntax/loc + core-match core-wrap + with-syntax with-syntax* + ast-rules + with-ast with-ast* + apply + let-values letrec-values letrec*-values + module + syntax-parameterize + rec alet alet* awhen + let-syntax letrec-syntax + parameterize parameterize* + error raise-syntax-error raise-type-error + catch guard + match match* + with with* + let/cc let/esc + lambda% + chain + identifier-rules + letrec* + while + let-hash + for for* for/collect + begin-ffi + test-suite test-case + ) + 'scheme-indent-function 1) + (gerbil-put '(syntax-case ast-case core-syntax-case core-ast-case + do-while + for/fold + ) + 'scheme-indent-function 2) + (gerbil-put '(def defvalues extern + defalias defsyntax defrule defrules defrules* + defstruct defclass defgeneric defmethod + definline definline* + define-values define-syntaxes + ) + 'scheme-indent-function 'defun) + ) + +(defun gerbil-init-fontlock () + (interactive) + (gerbil-fontlock-add + (cons + (concat + "(" (regexp-opt '("import" "export" "declare" "include" + "module" "extern" "cond-expand" "require" "provide" + "if" "apply" "eval" "set!" + "when" "unless" "not" + "case-lambda" + "core-syntax-case" "core-ast-case" + "syntax-case" "ast-case" "ast-rules" + "identifier-rules" + "core-match" + "with-syntax" "with-syntax*" + "with-ast" "with-ast*" + "call/cc" "call/values" + "begin-syntax" "begin-annotation" "begin0" + "let-values" "letrec-values" "letrec*-values" + "letrec*" "rec" + "quote" "quasiquote" "unquote" "unquote-splicing" + "parameterize" "syntax-parameterize" + "quote-syntax" + "syntax" "quasisyntax" "unsyntax" "unsyntax-splicing" + "syntax/loc" + "define-values" "define-alias" + "alet" "alet*" + "error" "raise" + "let/cc" "let/esc" + "unwind-protect" + "begin-foreign" "begin-ffi" + "cut" + "with" "with*" + "match" "match*" + "sync" "wait" + "foldl" "foldr" "andmap" "ormap" + "type-of" + "spawn" "spawn*" "spawn/name" "spawn/group" + ;; sugar + "try" "finally" "catch" "with-destroy" + "while" "until" "using" "defmethod/alias" + "with-methods" "with-class-methods" "with-class-method" + "hash" "hash-eq" "hash-eqv" "let-hash" "assert!" "awhen" + "chain" "is" + ;; coroutines + "continue" "yield" "coroutine" + ;; iterators + "for" "for*" "for/collect" "for/fold" + ;; actor messaging + "<-" "<<" "->" + ;; test + "run-tests!" "test-suite" "test-case" + "check" "checkf" "check-eq?" "check-not-eq?" "check-eqv?" + "check-not-eqv?" "check-equal?" "check-not-equal?" + "check-output" "check-predicate" "check-exception" + ) + t) + "\\>") + 1)) + (gerbil-fontlock-add + '("\\(XXX\\|TODO\\)" + (1 font-lock-warning-face))) + (gerbil-fontlock-add + '("\\_<\\(values\\)\\_>" + (1 font-lock-keyword-face))) + (gerbil-fontlock-add + '("\\_<\\(\\sw+:\\)\\_>" + (1 font-lock-builtin-face))) + + (gerbil-fontlock-add + '("\\<\\(<>\\|<\\.\\.\\.>\\>\\)" + (1 font-lock-builtin-face))) + + (gerbil-fontlock-add + '("\\_<\\([.][.][.]\\)" + (1 font-lock-builtin-face))) + (gerbil-fontlock-add + '("\\_<\\(=>\\)" + (1 font-lock-builtin-face))) + (gerbil-fontlock-add + '("\\(#?[`',]\\)" + (1 font-lock-keyword-face))) + (gerbil-fontlock-add + '("\\(#?,@\\)" + (1 font-lock-keyword-face))) + + (gerbil-fontlock-add + '("\\(%#\\w+\\)" + (1 font-lock-builtin-face))) + (gerbil-fontlock-add + '("\\_<\\(:\\sw+\\)\\_>" + (1 font-lock-variable-name-face))) + (gerbil-fontlock-add + '("(\\(@\\)" + (1 font-lock-variable-name-face))) + (gerbil-fontlock-add + '("(\\(def\\)\\s-+(?\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-function-name-face))) + (gerbil-fontlock-add + '("(\\(def\\)\\s-+\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-function-name-face))) + (gerbil-fontlock-add + '("(\\(def[*]\\)\\s-+(*\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-function-name-face))) + (gerbil-fontlock-add + '("(\\(defvalues\\)\\s-+(\\([^()]*\\))" + (1 font-lock-keyword-face) + (2 font-lock-function-name-face))) + (gerbil-fontlock-add + '("(\\(definline[*]?\\)\\s-+(?\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-function-name-face))) + (gerbil-fontlock-add + '("(\\(defsyntax\\)\\s-+(?\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-variable-name-face))) + (gerbil-fontlock-add + '("(\\(defsyntax-\\sw+\\)\\s-+(?\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-variable-name-face))) + (gerbil-fontlock-add + '("(\\(defrule\\)\\s-+(\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-variable-name-face))) + (gerbil-fontlock-add + '("(\\(defrules\\|defalias\\|module\\)\\s-+\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-variable-name-face))) + (gerbil-fontlock-add + '("(\\(defun\\|deflabel\\)\\s-+\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-function-name-face))) + (gerbil-fontlock-add + '("(\\(defasm\\|deftemplate\\)\\s-+\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-variable-name-face))) + (gerbil-fontlock-add + '("(\\(deftype\\)\\s-+(?\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-type-face))) + (gerbil-fontlock-add + '("(\\(def\\sw+-rules\\)\\s-+(?\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-variable-name-face))) + (gerbil-fontlock-add + '("(\\(defstruct\\|defclass\\|class\\|struct\\|interface\\|union\\)\\s-+(?\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-type-face))) + (gerbil-fontlock-add + '("(\\(defstruct-type\\|defclass-type\\)\\s-+\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-type-face))) + (gerbil-fontlock-add + '("(\\(defgeneric\\|defmethod[*]?\\)\\s-+[{(]?\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-function-name-face))) + (gerbil-fontlock-add + '("(\\(defproto\\)\\s-+\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-type-face))) + (gerbil-fontlock-add + '("(\\(defregister\\|defvar\\|defconst\\)\\s-+\\(\\sw+\\)" + (1 font-lock-keyword-face) + (2 font-lock-variable-name-face))) + + (gerbil-fontlock-add + '("\\_<\\([?!&]+\\)" + (1 font-lock-builtin-face))) + (gerbil-fontlock-add + '("\\<\\(#[tf]\\|#!\\w+\\)" + (1 font-lock-builtin-face))) + (gerbil-fontlock-add + '("\\([_#]+\\)" + (1 font-lock-builtin-face))) + + (gerbil-fontlock-add + '("\\([{}]\\|\\[\\|\\]\\)" + (1 font-lock-variable-name-face))) + ) + +(defun gerbil-pretty-lambdas () + (interactive) + (gerbil-fontlock-add + `("\\(lambda\\)" + (0 (progn + (compose-region (match-beginning 1) (match-end 1) + ,(make-char 'greek-iso8859-7 107)) + nil))))) + +(defun gerbil-init () + (interactive) + (gerbil-init-keywords) + (gerbil-init-fontlock) + (when window-system + (gerbil-pretty-lambdas))) + +(define-key scheme-mode-map (kbd "C-x 9") 'restart-scheme) +(define-key inferior-scheme-mode-map (kbd "C-x 9") 'restart-scheme) + +(defvar gerbil-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map scheme-mode-map) + (define-key map (kbd "C-c C-f") 'gerbil-compile-current-buffer) + (define-key map (kbd "C-c C-i") 'gerbil-import-current-buffer) + (define-key map (kbd "C-c C-r") 'gerbil-reload-current-buffer) + (define-key map (kbd "C-c C-b") 'gerbil-build) + (define-key map (kbd "C-c C-e") 'scheme-send-definition) + (define-key map (kbd "C-c C-c") 'scheme-send-region) + map)) + +(defvar gerbil-program-name "gxi") +(defvar gerbil-mode-hook nil) + +;;;###autoload +(define-derived-mode gerbil-mode scheme-mode + "Gerbil" "Major mode for Gerbil." + (kill-all-local-variables) + (use-local-map gerbil-mode-map) + (setq mode-name "Gerbil") + (setq major-mode 'gerbil-mode) + (setq scheme-program-name gerbil-program-name) + (setq comment-start ";;") + (scheme-mode-variables) + (gerbil-init) + (run-hooks 'gerbil-mode-hook)) + +;;;###autoload +(progn + (add-to-list 'auto-mode-alist '("\\.ss\\'" . gerbil-mode)) + (modify-coding-system-alist 'file "\\.ss\\'" 'utf-8)) + + +(provide 'gerbil-mode) + +;;; gerbil-mode.el ends here diff --git a/packages.el b/packages.el new file mode 100644 index 0000000..7fb0274 --- /dev/null +++ b/packages.el @@ -0,0 +1,76 @@ +;;; packages.el --- gerbil layer packages file for Spacemacs. +;; +;; Copyright (c) 2012-2020 Sylvain Benner & Contributors +;; +;; Author: DESKTOP-H7KNR8E +;; URL: https://github.com/syl20bnr/spacemacs +;; +;; This file is not part of GNU Emacs. +;; +;;; License: GPLv3 + +;;; Commentary: + +;; See the Spacemacs documentation and FAQs for instructions on how to implement +;; a new layer: +;; +;; SPC h SPC layers RET +;; +;; +;; Briefly, each package to be installed or configured by this layer should be +;; added to `gerbil-packages'. Then, for each package PACKAGE: +;; +;; - If PACKAGE is not referenced by any other Spacemacs layer, define a +;; function `gerbil/init-PACKAGE' to load and initialize the package. + +;; - Otherwise, PACKAGE is already referenced by another Spacemacs layer, so +;; define the functions `gerbil/pre-init-PACKAGE' and/or +;; `gerbil/post-init-PACKAGE' to customize the package as it is loaded. + +;;; Code: + +(defconst gerbil-packages + '(evil-cleverparens + (gerbil-mode :location local) + smartparens) + "The list of Lisp packages required by the gerbil layer. + +Each entry is either: + +1. A symbol, which is interpreted as a package to be installed, or + +2. A list of the form (PACKAGE KEYS...), where PACKAGE is the + name of the package to be installed or loaded, and KEYS are + any number of keyword-value-pairs. + + The following keys are accepted: + + - :excluded (t or nil): Prevent the package from being loaded + if value is non-nil + + - :location: Specify a custom installation location. + The following values are legal: + + - The symbol `elpa' (default) means PACKAGE will be + installed using the Emacs package manager. + + - The symbol `local' directs Spacemacs to load the file at + `./local/PACKAGE/PACKAGE.el' + + - A list beginning with the symbol `recipe' is a melpa + recipe. See: https://github.com/milkypostman/melpa#recipe-format") + +(defun gerbil/pre-init-evil-cleverparens () + (spacemacs|use-package-add-hook evil-cleverparens + :pre-init + (add-to-list 'evil-lisp-safe-structural-editing-modes 'gerbil-mode))) + +(defun gerbil/init-gerbil-mode () + (use-package gerbil-mode)) + +(defun gerbil/post-init-smartparens () + (with-eval-after-load 'smartparens + (sp-local-pair 'gerbil-mode "`" nil :actions nil) + (sp-local-pair 'gerbil-mode "'" nil :actions nil))) + +;;; packages.el ends here