Coverage report: /home/ellis/comp/core/lib/cli/tools/term.lisp

KindCoveredAll%
expression095 0.0
branch012 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; term.lisp --- Terminal Tools
2
 
3
 ;; Control and spawn terminal consoles from Lisp.
4
 
5
 ;;; Commentary:
6
 
7
 ;; This package is intended to make it easier to work with interactive
8
 ;; terminal programs in a Lispy manner.
9
 
10
 ;;; Code:
11
 (in-package :cli/tools/term)
12
 
13
 (defparameter *alacritty-config-path* (merge-pathnames ".config/alacritty.toml" (user-homedir-pathname)))
14
 
15
 (defparameter *term* (or (find-exe "alacritty") (find-exe "xterm")))
16
 
17
 (deferror term-error (simple-error error) ())
18
 
19
 (defconfig term-config (ast) ())
20
 
21
 (defconfig alacritty-config (term-config toml-document) 
22
   ((path :initarg :path :initform *alacritty-config-path* :accessor path)))
23
 
24
 (defun load-alacritty-config (&optional (path *alacritty-config-path*))
25
   (change-class
26
    (deserialize path :toml)
27
    'alacritty-config
28
    :path path))
29
 
30
 (defmethod make-config ((self (eql :alacritty)) &key (path *alacritty-config-path*))
31
   (load-alacritty-config path))
32
 
33
 (defun term-error (fmt &rest args)
34
   (error 'term-error :format-arguments args :format-control fmt))
35
 
36
 (defun run-term (&rest args)
37
   (apply #'sb-ext:run-program *term* args))
38
 
39
 (defmacro with-term ((sym &key args input output) &body body)
40
   `(let ((,sym (run-term ,args
41
                              ,@(when input '(:input :stream))
42
                              ,@(when output '(:output :stream))
43
                              :wait nil)))
44
      (let (,@(when input `((,input (sb-ext:process-input ,sym))))
45
            ,@(when output `((,output (sb-ext:process-output ,sym)))))
46
        ,@body)))
47
 
48
 ;;; Terminal Recording
49
 (define-cli-tool :script (&rest args)
50
   (let ((proc (sb-ext:run-program *script* (or args nil) :output t)))
51
     (unless (not (eq 0 (sb-ext:process-exit-code proc)))
52
       (script-error "script command failed: ~A " args))))
53
   
54
 (define-cli-tool :scriptreplay (&rest args)
55
   (let ((proc (sb-ext:run-program *scriptreplay* (or args nil) :output t)))
56
     (unless (not (eq 0 (sb-ext:process-exit-code proc)))
57
       (scriptreplay-error "scriptreplay command failed: ~A " args))))
58
 
59
 ;;; fbterm
60
 (define-cli-tool :fbterm (&rest args)
61
   (let ((proc (sb-ext:run-program *fbterm* (or args nil) :output t)))
62
     (unless (not (eq 0 (sb-ext:process-exit-code proc)))
63
       (fbter-error "FBTERM command failed: ~A ~A" *fbterm* args))))