4.1 Enigma API: Metadata🔗

Current value: enigma

Current value: 1.0.3

Current value: MPL-2.0

The source code of this module:

#lang racket/base

(require racket/contract/base)

(provide

(contract-out

[name string?]

[version string?]

[license string?]))

(define name "enigma")

(define version "1.0.3")

(define license "MPL-2.0")

4.2 Enigma API: CLI Application🔗

The source code of this module:

#lang racket/base

(require json)

(require racket/cmdline)

(require racket/file)

(require racket/match)

(require threading)

(require "../metadata.rkt")

(require "../emacs/package/archives.rkt")

(require "../emacs/system/run-emacs.rkt")

(require "../subcommands/compile.rkt")

(require "../subcommands/dependencies.rkt")

(require "../subcommands/install.rkt")

(require "../subcommands/launch.rkt")

(require "../subcommands/test.rkt")

(require "../log/simplelog.rkt")

(require "../system/output/color.rkt")

(require "../system/utils/path.rkt")

(provide app-cli)

(define (program-parameter/execution-directory/guard path)

(define actual-path

(~> path

expand-user-path

path->complete-path

simplify-path))

(match actual-path

[(? directory-exists? d) d]

[(? file-exists? f) (path->directory f)]

[_ (raise (exn:fail (format "Given path does not exist, given: ~v" actual-path)

(current-continuation-marks)))]))

(define (program-parameter/user-emacs-directory/guard path)

(cond

[path

(~> path

expand-user-path

path->complete-path

simplify-path

path->string)]

[else #false]))

(define program-pseudo-parameter/extra-emacs-flags

(make-parameter '()))

(define program-parameter/execution-directory

(make-parameter (current-directory)

program-parameter/execution-directory/guard))

(define program-parameter/user-emacs-directory

(make-parameter #false

program-parameter/user-emacs-directory/guard))

(define (display-jsexpr jsexpr)

(~>> jsexpr

(jsexpr->string #:indent 2)

displayln))

(define (call-for-exit procedure/arity2)

(begin

(define-values (result-code result-hash)

(procedure/arity2 (program-parameter/execution-directory)

(program-pseudo-parameter/extra-emacs-flags)))

(display-jsexpr result-hash)

(match result-hash

[(list) (simplelog-error "No matching Emacs lisp files were found")]

[_ (void)])

(exit result-code)))

(define (run-action action emacs-flags)

(parameterize ([current-directory (program-parameter/execution-directory)]

[program-pseudo-parameter/extra-emacs-flags emacs-flags])

(simplelog-debug "Called with: action: ~v and emacs-flags: ~v"

action

emacs-flags)

(simplelog-debug "Working in directory: ~a" (current-directory))

(define maybe-user-emacs-directory

(program-parameter/user-emacs-directory))

(cond

[maybe-user-emacs-directory

(define emacs-directory-setup-expr

`(progn

(setq user-emacs-directory ,maybe-user-emacs-directory)

(setq package-user-dir

(expand-file-name "elpa" user-emacs-directory))))

(simplelog-debug "User's Emacs directory: ~a" maybe-user-emacs-directory)

(make-directory* maybe-user-emacs-directory)

(program-pseudo-parameter/extra-emacs-flags

`("--eval"

,(format "~s" emacs-directory-setup-expr)

,@(program-pseudo-parameter/extra-emacs-flags)))]

[else (void)])

(match action

['compile (call-for-exit compile-found-emacs-lisp-files)]

['dependencies (call-for-exit install-emacs-lisp-files-dependencies)]

['install (call-for-exit install-found-emacs-lisp-files)]

['launch (call-for-exit launch-with-found-emacs-lisp-files)]

['test (call-for-exit test-found-emacs-lisp-files)]

[_ (raise (exn:fail (format "Unknown action, given: ~v" action)

(current-continuation-marks)))])))

(define (subcommand/dependencies argv)

(command-line

#:program "enigma dependencies"

#:argv argv

#:multi

[("--clear-package-archives")

"Clear the Emacs package-archives of any records"

(parameter/emacs-package-archives '())]

[("--add-package-archive")

package-archive-url

"Register a package-archive record"

(parameter/emacs-package-archives

(cons package-archive-url (parameter/emacs-package-archives)))]

#:args emacs-flags

(run-action 'dependencies emacs-flags)))

(define (subcommand/compile argv)

(command-line

#:program "enigma compile"

#:argv argv

#:args emacs-flags

(run-action 'compile emacs-flags)))

(define (subcommand/test argv)

(command-line

#:program "enigma test"

#:argv argv

#:once-each

[("--buttercup-exe")

buttercup-exe

"Set a custom Buttercup executable path"

(parameter/buttercup-executable buttercup-exe)]

[("--ert-runner-exe")

ert-runner-exe

"Set a custom ERT-Runner executable path"

(parameter/ert-runner-executable ert-runner-exe)]

#:args emacs-flags

(run-action 'test emacs-flags)))

(define (subcommand/launch argv)

(command-line

#:program "enigma launch"

#:argv argv

#:args emacs-flags

(run-action 'launch emacs-flags)))

(define (subcommand/install argv)

(command-line

#:program "enigma install"

#:argv argv

#:multi

[("--clear-package-archives")

"Clear the Emacs package-archives of any records"

(parameter/emacs-package-archives '())]

[("--add-package-archive")

package-archive-url

"Register a package-archive record"

(parameter/emacs-package-archives

(cons package-archive-url (parameter/emacs-package-archives)))]

#:args emacs-flags

(run-action 'install emacs-flags)))

(define (app-cli argv)

(command-line

#:program name

#:argv argv

#:usage-help "requires a subcommand, one of: compile, dependencies, install, launch or test"

#:ps "

Available subcommands:

- compile - compile found Emacs Lisp files,

- dependencies - install Emacs Lisp files' dependencies (\"Package-Requires\"),

- install - install (suitable) Emacs Lisp files as packages (their parent dir),

- launch - launch GNU Emacs in a prepared environment,

- test - run found Emacs Lisp tests (supports: ert, ert-runner or buttercup).

Original author: Maciej xgqt Barć. Licensed under the permissive

copyleft MPL-2.0 license (http://mozilla.org/MPL/2.0/). No warranty.

"

#:once-each

[("-V" "--version")

"Show the program's currently used version"

(begin

(displayln version)

(exit 0))]

[("--license")

"Show the program's license"

(begin

(displayln license)

(exit 0))]

[("-C" "--directory")

directory

"Change to directory directory before doing anything else"

(program-parameter/execution-directory directory)]

[("--no-color")

"Suppress displaying colors by the program"

(parameter/colored-output? #false)]

[("--user-emacs-directory")

directory

"Overwrite the user's Emacs directory"

(program-parameter/user-emacs-directory directory)]

[("--emacs-exe")

emacs-exe

"Set a custom GNU Emacs executable path"

(parameter/emacs-executable emacs-exe)]

#:args (subcommand . subcommand-arguments)

(match subcommand

[(or "subcommands")

(displayln "Available subcommands:")

(for ([s '("compile" "dependencies" "install" "launch" "test")])

(printf "  - ~a\n" s))]

[(or "compile" "com" "c")

(subcommand/compile subcommand-arguments)]

[(or "dependencies" "deps" "d")

(subcommand/dependencies subcommand-arguments)]

[(or "install" "inst" "i")

(subcommand/install subcommand-arguments)]

[(or "launch" "l")

(subcommand/launch subcommand-arguments)]

[(or "test" "t")

(subcommand/test subcommand-arguments)]

[_ (raise (exn:fail (format "Unknown subcommand, given: ~v" subcommand)

(current-continuation-marks)))])))

4.3 Enigma API: Compile Subcommand🔗

Returns the values that indicate: exact-integer? total compilation success and a list of objects that describe properties of compiled files.

The source code of this module:

#lang racket/base

(require racket/contract/base)

(require racket/match)

(require "../emacs/file/emacs-context.rkt")

(require "../emacs/path/load-path.rkt")

(require "../emacs/system/run-emacs.rkt")

(require "../system/utils/path.rkt")

(require "../system/utils/time.rkt")

(require "../log/simplelog.rkt")

(require "../compiler/stamp/stamp.rkt")

(provide

(contract-out

[compile-found-emacs-lisp-files

(-> path-string? (listof string?)

(values exact-integer? (listof hash?)))]))

(define (compile-emacs-lisp-file/inner file-path load-path extra-emacs-flags)

(define cmdline-args

(append (make-emacs-cmdline-args load-path extra-emacs-flags)

`("-batch" "-f" "batch-byte-compile" ,(path->string file-path))))

(define exit-code (run-emacs cmdline-args))

(match exit-code

[0 (create-stamp file-path "compiled")]

[_ (void)])

exit-code)

(define (compile-emacs-lisp-file file-path load-path extra-emacs-flags)

(cond

[(stamp-actual? file-path "compiled")

(simplelog-debug "Skipping up-to-date file: ~a" (path->name file-path))

0]

[else

(define name (path->name file-path))

(with-time-report

#:announce

(lambda ()

(simplelog-info "Compiling ~a" name))

#:report

(lambda (elapsed)

(simplelog-debug "Compilation of ~a took ~ams" name elapsed))

#:thunk

(lambda ()

(compile-emacs-lisp-file/inner file-path load-path extra-emacs-flags)))]))

(define (compile-found-emacs-lisp-files start-path extra-emacs-flags)

(define result-code (make-parameter 0))

(define-values (emacs-lisp-files load-path)

(find-emacs-lisp-context start-path))

(define sources-count (length emacs-lisp-files))

(define result-hash

(for/list ([emacs-lisp-file emacs-lisp-files]

[i (in-naturals 1)])

(simplelog-status i sources-count "compile-emacs-lisp-file ~a" emacs-lisp-file)

(define exit-code

(compile-emacs-lisp-file emacs-lisp-file load-path extra-emacs-flags))

(define successful? (= 0 exit-code))

(define compiled-file

(match successful?

[#true

(match (path-replace-extension emacs-lisp-file #".elc")

[(? file-exists? f) (path->string f)]

[_ #false])]

[_ #false]))

(define h

(hash 'compiled-file compiled-file

'exit-code exit-code

'file-path (path->string emacs-lisp-file)

'successful? successful?))

(when (not successful?)

(result-code exit-code))

h))

(values (result-code) result-hash))

4.4 Enigma API: Dependencies Subcommand🔗

Returns the values that indicate: exact-integer? total installation success and a list of objects that describe properties of installed dependencies.

The source code of this module:

#lang racket/base

(require racket/contract/base)

(require "../emacs/file/content-guess.rkt")

(require "../emacs/file/emacs-context.rkt")

(require "../emacs/package/archives.rkt")

(require "../emacs/path/load-path.rkt")

(require "../emacs/system/run-emacs.rkt")

(require "../log/simplelog.rkt")

(require "../system/utils/time.rkt")

(provide

(contract-out

[install-emacs-lisp-files-dependencies

(-> path-string? (listof string?)

(values exact-integer? (listof hash?)))]))

(define (install-remote-emacs-package package-name extra-emacs-flags)

(define package-bootstrap-expr

`(progn

(setq package-archives (quote ,(get-emacs-package-archives)))

(package-initialize)

(package-install (quote ,package-name))))

(define cmdline-args

(append (make-emacs-cmdline-args '() extra-emacs-flags)

`("-batch"

"--eval" ,(format "~s" package-bootstrap-expr))))

(define exit-code

(with-time-report

#:announce

(lambda ()

(simplelog-success "Installing dependency ~a" package-name))

#:report

(lambda (elapsed)

(simplelog-debug "Installing dependency ~a took ~ams" package-name elapsed))

#:thunk

(lambda ()

(run-emacs cmdline-args))))

(when (= 0 exit-code)

(simplelog-success "Install of remote package ~v succeeded" package-name))

exit-code)

(define (install-emacs-lisp-files-dependencies start-path extra-emacs-flags)

(define result-code (make-parameter 0))

(define-values (emacs-lisp-files _load-path)

(find-emacs-lisp-context start-path))

(define refresh-result (refresh-emacs-package-archives extra-emacs-flags))

(when (> refresh-result 0)

(result-code refresh-result))

(define sources

(for/fold ([results '()])

([emacs-lisp-file emacs-lisp-files])

(define version (guess-file-version emacs-lisp-file))

(define dependencies (guess-file-dependencies emacs-lisp-file))

(cond

[(and version (not (null? dependencies)))

(cons (cons emacs-lisp-file dependencies) results)]

[else results])))

(define sources-count (length sources))

(define result-hash

(for/list ([emacs-lisp-pair (reverse sources)]

[i (in-naturals 1)])

(define emacs-lisp-file (car emacs-lisp-pair))

(define dependencies (cdr emacs-lisp-pair))

(simplelog-status i sources-count "install-remote-emacs-package ~a" emacs-lisp-file)

(simplelog-debug "Found dependencies: ~v in file ~a"

dependencies emacs-lisp-file)

(define exit-codes

(for/list ([package-name dependencies])

(install-remote-emacs-package package-name extra-emacs-flags)))

(define first-failure-exit-code

(for/first ([exit-code exit-codes] #:when (> exit-code 0)) exit-code))

(define successful? (not first-failure-exit-code))

(when (not successful?)

(result-code first-failure-exit-code))

(hash 'dependencies (format "~s" dependencies)

'file-path (path->string emacs-lisp-file)

'successful? successful?)))

(values (result-code) result-hash))

4.5 Enigma API: Install Subcommand🔗

Returns the values that indicate: exact-integer? total installation success and a list of objects that describe properties of installed files.

The source code of this module:

#lang racket/base

(require racket/contract/base)

(require racket/match)

(require "../emacs/file/emacs-context.rkt")

(require "../emacs/path/load-path.rkt")

(require "../emacs/system/run-emacs.rkt")

(require "../system/utils/path.rkt")

(require "../system/utils/time.rkt")

(require "../log/simplelog.rkt")

(require "../compiler/stamp/stamp.rkt")

(provide

(contract-out

[compile-found-emacs-lisp-files

(-> path-string? (listof string?)

(values exact-integer? (listof hash?)))]))

(define (compile-emacs-lisp-file/inner file-path load-path extra-emacs-flags)

(define cmdline-args

(append (make-emacs-cmdline-args load-path extra-emacs-flags)

`("-batch" "-f" "batch-byte-compile" ,(path->string file-path))))

(define exit-code (run-emacs cmdline-args))

(match exit-code

[0 (create-stamp file-path "compiled")]

[_ (void)])

exit-code)

(define (compile-emacs-lisp-file file-path load-path extra-emacs-flags)

(cond

[(stamp-actual? file-path "compiled")

(simplelog-debug "Skipping up-to-date file: ~a" (path->name file-path))

0]

[else

(define name (path->name file-path))

(with-time-report

#:announce

(lambda ()

(simplelog-info "Compiling ~a" name))

#:report

(lambda (elapsed)

(simplelog-debug "Compilation of ~a took ~ams" name elapsed))

#:thunk

(lambda ()

(compile-emacs-lisp-file/inner file-path load-path extra-emacs-flags)))]))

(define (compile-found-emacs-lisp-files start-path extra-emacs-flags)

(define result-code (make-parameter 0))

(define-values (emacs-lisp-files load-path)

(find-emacs-lisp-context start-path))

(define sources-count (length emacs-lisp-files))

(define result-hash

(for/list ([emacs-lisp-file emacs-lisp-files]

[i (in-naturals 1)])

(simplelog-status i sources-count "compile-emacs-lisp-file ~a" emacs-lisp-file)

(define exit-code

(compile-emacs-lisp-file emacs-lisp-file load-path extra-emacs-flags))

(define successful? (= 0 exit-code))

(define compiled-file

(match successful?

[#true

(match (path-replace-extension emacs-lisp-file #".elc")

[(? file-exists? f) (path->string f)]

[_ #false])]

[_ #false]))

(define h

(hash 'compiled-file compiled-file

'exit-code exit-code

'file-path (path->string emacs-lisp-file)

'successful? successful?))

(when (not successful?)

(result-code exit-code))

h))

(values (result-code) result-hash))