Complete jerboa-emacs port: main.ss, bracket lists, winner dedup
ober
ec9dc7542395e239e1e63365f69b3787454ccd44
--- a/.gitignore +++ b/.gitignore @@ -7,3 +7,6 @@ src/.jerbuild-hashes # Compiled Chez artifacts lib/**/*.so lib/**/*.wpo + +# Build symlinks / local artifacts +libjsh-ffi.so --- a/Makefile +++ b/Makefile @@ -7,11 +7,11 @@ JERBUILD = $(SCHEME) --libdirs $(JERBOA)/lib --script $(JERBOA)/jerbuild.ss export LD_LIBRARY_PATH := $(HOME)/mine/chez-pcre2:$(HOME)/mine/chez-scintilla:$(HOME)/mine/jerboa-shell:$(LD_LIBRARY_PATH) export CHEZ_SCINTILLA_LIB := $(HOME)/mine/chez-scintilla -.PHONY: all build rebuild test-tier0 test-tier2 test-tier3 test-tier4 test-tier5 test clean clean-generated +.PHONY: all build rebuild run test-tier0 test-tier2 test-tier3 test-tier4 test-tier5 test clean clean-generated all: build test -# Generate lib/jemacs/*.sls from src/jemacs/*.ss (incremental) +# Generate lib/jerboa-emacs/*.sls from src/jerboa-emacs/*.ss (incremental) build: $(JERBUILD) src/ lib/ @@ -19,6 +19,9 @@ build: rebuild: $(JERBUILD) src/ lib/ --force +run: build + $(SCHEME) $(LIBDIRS) --script main.ss + test: build test-tier0 test-tier2 test-tier3 test-tier4 test-tier5 test-tier0: @@ -40,5 +43,5 @@ clean: find lib -name '*.so' -delete 2>/dev/null; true clean-generated: - rm -rf lib/jemacs/ + rm -rf lib/jerboa-emacs/ rm -f src/.jerbuild-hashes new file mode 100644 --- /dev/null +++ b/lib/test/atom.sls @@ -0,0 +1,6 @@ +#!chezscheme +(library (test atom) + (export test-it) + (import (chezscheme) + (std misc atom)) + (define (test-it) (atom? (atom 42)))) new file mode 100644 --- /dev/null +++ b/main.ss @@ -0,0 +1,67 @@ +#!/usr/bin/env scheme-script +#!chezscheme +;;; main.ss — Executable entry point for jemacs (jerboa-emacs) + +(import (except (chezscheme) make-hash-table hash-table? iota 1+ 1-) + (jerboa core) + (jerboa runtime) + (std sugar) + (jerboa-emacs editor) + (jerboa-emacs window) + (chez-scintilla tui) + (jerboa-emacs app) + (jerboa-emacs editor-extra-org) + (jerboa-emacs ipc) + (jerboa-emacs debug-repl)) + +;;; Version manifest +(define version-manifest + '(("" . "jerboa-emacs") + ("Jerboa" . "master") + ("Chez Scheme" . "10.x"))) + +(define (parse-repl-port args) + "Return (port-num . filtered-args) if --repl <port> is present, else #f." + (let loop ((rest args) (acc '())) + (cond + ((null? rest) #f) + ((and (string=? (car rest) "--repl") + (pair? (cdr rest)) + (string->number (cadr rest))) + (cons (string->number (cadr rest)) + (append (reverse acc) (cddr rest)))) + (else (loop (cdr rest) (cons (car rest) acc)))))) + +(define (main . args) + (cond + ((member "--version" args) + (display (string-append "jemacs " (cdr (car version-manifest)))) (newline) + (for-each (lambda (p) + (when (not (string=? (car p) "")) + (display (string-append (car p) " " (cdr p))) (newline))) + (cdr version-manifest))) + ((member "--help" args) + (display "Usage: jemacs [OPTIONS] [FILES...]") (newline) + (display "Options:") (newline) + (display " --version Show version information") (newline) + (display " --help Show this help message") (newline) + (display " --repl <port> Start TCP debug REPL on given port (0=auto)") (newline)) + (else + (let* ((repl-port-env (getenv "JEMACS_REPL_PORT")) + (repl-info (or (parse-repl-port args) + (and repl-port-env + (cons (string->number repl-port-env) args)))) + (clean-args (if repl-info (cdr repl-info) args)) + (app (app-init! clean-args))) + (when repl-info + (start-debug-repl! (car repl-info))) + (try + (app-run! app) + (finally + (when *desktop-save-mode* (tui-session-save! app)) + (when repl-info (stop-debug-repl!)) + (stop-ipc-server!) + (frame-shutdown! (app-state-frame app)) + (tui-shutdown!))))))) + +(apply main (command-line-arguments)) --- a/src/jerboa-emacs/editor-cmds-b.ss +++ b/src/jerboa-emacs/editor-cmds-b.ss @@ -2043,12 +2043,11 @@ (def *customizable-vars* ;; list of (name description getter setter) - (list - (list "scroll-margin" "Lines of margin for scrolling" (lambda () *scroll-margin*) (lambda (v) (set! *scroll-margin* v))) - (list "require-final-newline" "Ensure final newline on save" (lambda () *require-final-newline*) (lambda (v) (set! *require-final-newline* v))) - (list "delete-trailing-whitespace-on-save" "Strip trailing whitespace" (lambda () *delete-trailing-whitespace-on-save*) (lambda (v) (set! *delete-trailing-whitespace-on-save* v))) - (list "global-auto-revert-mode" "Auto-reload changed files" (lambda () *global-auto-revert-mode*) (lambda (v) (set! *global-auto-revert-mode* v) (set! *auto-revert-mode* v))) - (list "flymake-mode" "Syntax checking" (lambda () *flymake-mode*) (lambda (v) (set! *flymake-mode* v))))) + [["scroll-margin" "Lines of margin for scrolling" (lambda () *scroll-margin*) (lambda (v) (set! *scroll-margin* v))] + ["require-final-newline" "Ensure final newline on save" (lambda () *require-final-newline*) (lambda (v) (set! *require-final-newline* v))] + ["delete-trailing-whitespace-on-save" "Strip trailing whitespace" (lambda () *delete-trailing-whitespace-on-save*) (lambda (v) (set! *delete-trailing-whitespace-on-save* v))] + ["global-auto-revert-mode" "Auto-reload changed files" (lambda () *global-auto-revert-mode*) (lambda (v) (set! *global-auto-revert-mode* v) (set! *auto-revert-mode* v))] + ["flymake-mode" "Syntax checking" (lambda () *flymake-mode*) (lambda (v) (set! *flymake-mode* v))]]) (def (cmd-customize app) "Display a customization buffer showing all registered variables by group." @@ -2058,8 +2057,8 @@ (win (current-window fr)) (buf (buffer-create! "*Customize*" ed)) (groups (custom-groups)) - (lines (list "Gemacs Customize" - "================" ""))) + (lines ["Gemacs Customize" + "================" ""])) (buffer-attach! ed buf) (set! (edit-window-buffer win) buf) (for-each --- a/src/jerboa-emacs/editor-extra-web.ss +++ b/src/jerboa-emacs/editor-extra-web.ss @@ -20,7 +20,8 @@ :jerboa-emacs/window :jerboa-emacs/modeline :jerboa-emacs/echo - :jerboa-emacs/editor-extra-helpers) + :jerboa-emacs/editor-extra-helpers + (only-in :jerboa-emacs/editor-core winner-save-config!)) ;; EWW browser - text-mode web browser using litehtml for HTML rendering @@ -268,35 +269,7 @@ ;; Winner mode (window configuration undo/redo) ;; Saves/restores: number of windows, current window index, buffer names per window - -(def *winner-max-history* 50) ; Max configs to remember - -(def (winner-save-config! app) - "Save current window configuration to winner history." - (let* ((fr (app-state-frame app)) - (wins (frame-windows fr)) - (num-wins (length wins)) - (current-idx (frame-current-idx fr)) - (buffers (map (lambda (w) - (let ((buf (edit-window-buffer w))) - (if buf (buffer-name buf) "*scratch*"))) - wins)) - (config (list num-wins current-idx buffers)) - (history (app-state-winner-history app))) - ;; Don't save duplicate consecutive configs - (unless (and (not (null? history)) - (equal? config (car history))) - ;; Truncate future (redo) history when adding new config - (let ((idx (app-state-winner-history-idx app))) - (when (> idx 0) - (set! history (list-tail history idx)) - (set! (app-state-winner-history-idx app) 0))) - ;; Add new config, limit size - (let ((new-history (cons config history))) - (set! (app-state-winner-history app) - (if (> (length new-history) *winner-max-history*) - (take new-history *winner-max-history*) - new-history)))))) +;; winner-save-config! is defined in editor-core and imported above (def (winner-restore-config! app config) "Restore a window configuration from winner history." --- a/src/jerboa-emacs/editor-extra.ss +++ b/src/jerboa-emacs/editor-extra.ss @@ -18,7 +18,8 @@ :jerboa-emacs/echo (only-in :jerboa-emacs/editor-core cmd-undo-region cmd-display-buffer-in-side-window cmd-toggle-side-window - cmd-info-reader cmd-project-tree-git) + cmd-info-reader cmd-project-tree-git + winner-save-config!) (only-in :jerboa-emacs/editor-cmds-a cmd-project-tree-create-file cmd-project-tree-delete-file cmd-project-tree-rename-file cmd-jemacs-doc