Excise terminal so it can grovel

Author: eschulte

.qlfile.grammatech

@@ -5,3 +5,4 @@ git stefil+ https://github.com/GrammaTech/stefil-.git main
 git cffi https://github.com/death/cffi
 git cl-tree-sitter https://github.com/death/cl-tree-sitter
 git serapeum https://github.com/ruricolist/serapeum
+git terminal http://git.grammatech.com/synthesis/terminal.git

Makefile

@@ -71,7 +71,6 @@ DOC_PACKAGES =								\
 	software-evolution-library/utility/json				\
 	software-evolution-library/utility/range			\
 	software-evolution-library/utility/task				\
-	software-evolution-library/utility/terminal			\
 	software-evolution-library/view
 
 DOC_DEPS = doc/software-evolution-library/GrammaTech-CLA-SEL.pdf

utility/terminal.lisp

@@ -27,10 +27,10 @@
   (:use
    :gt/full
    :diff
-   :cl-interpol
+   :terminal
    :software-evolution-library
    :software-evolution-library/utility/debug
-   :software-evolution-library/utility/terminal)
+   :terminal)
   (:shadow :diff)
   (:shadowing-import-from :arrow-macros :-<>> :-<> :<>) ; FIXME: Remove.
   (:export :*view-stream*
@@ -46,47 +46,8 @@
            :*view-max-best-lines*
            :*view-max-best-offset*
            :*view-functions*
-           ;; Colors.
-           :+set-G1+
-           :+reset-G1+
-           :+b-start+
-           :+b-stop+
-           :+b-h+
-           :+b-v+
-           :+b-lt+
-           :+b-rt+
-           :+b-lb+
-           :+b-rb+
-           :+b-x+
-           :+b-vr+
-           :+b-vl+
-           :+b-ht+
-           :+b-hb+
-           :+term-home+
-           :+term-clear+
-           :+ceol+
-           :+cursor-hide+
-           :+cursor-show+
-           :+color-BLK+
-           :+color-RED+
-           :+color-GRN+
-           :+color-BRN+
-           :+color-BLU+
-           :+color-MGN+
-           :+color-CYA+
-           :+color-NOR+
-           :+color-GRA+
-           :+color-LRD+
-           :+color-LGN+
-           :+color-YEL+
-           :+color-LBL+
-           :+color-PIN+
-           :+color-LCY+
-           :+color-BRI+
-           :+color-RST+
            :+golden-ratio+
            :label-line-print
-           ;; Utility functions.
            :best-print
            ;; View functions.
            :timing-view-function
@@ -107,12 +68,9 @@
 (in-package :software-evolution-library/view)
 (in-readtable :curry-compose-reader-macros)
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (enable-interpol-syntax)
-  (defvar *view-stream* t
-    "Dynamically bind to use modify."))
-
-(defvar *view-length* 65
+(defvar *view-length*
+  (handler-case (nth-value 2 (term-size))
+    (ioctl (e) (declare (ignore e)) 72))
   "Dynamically bind to use modify.")
 
 (defvar *view-delay* 2
@@ -149,77 +107,13 @@ For example a description of the evolution target.")
 (defvar *view-max-best-offset* 0
   "Offset into the lines of the best candidate to show.")
 
-(define-constant +golden-ratio+ 21/34)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  ;; AFL, forgive me this.
-  (mapc (lambda (triple)
-          (destructuring-bind (name value documentation) triple
-            (eval `(define-constant ,name ,value :test 'equalp
-                                    :documentation ,documentation))))
-        '((+set-G1+      #?"\x1b)0"   "Set G1 for box drawing")
-          (+reset-G1+    #?"\x1b)B"   "Reset G1 to ASCII")
-          (+b-start+     #?"\x0e"     "Enter G1 drawing mode")
-          (+b-stop+      #?"\x0f"     "Leave G1 drawing mode")
-          (+b-h+         #\q        "Horizontal line")
-          (+b-v+         #\x        "Vertical line")
-          (+b-lt+        #\l        "Left top corner")
-          (+b-rt+        #\k        "Right top corner")
-          (+b-lb+        #\m        "Left bottom corner")
-          (+b-rb+        #\j        "Right bottom corner")
-          (+b-x+         #\n        "Cross")
-          (+b-vr+        #\t        "Vertical, branch right")
-          (+b-vl+        #\u        "Vertical, branch left")
-          (+b-ht+        #\v        "Horizontal, branch top")
-          (+b-hb+        #\w        "Horizontal, branch bottom")
-          (+term-home+   #?"\x1b[H"     "Set terminal back to home (top left).")
-          (+term-clear+  #?"\x1b[H" "Clear terminal.")
-          (+ceol+        #?"\x1b[0K"    "Clear to end of line.")
-          (+cursor-hide+ #?"\x1b[?25l"  "Hide the cursor.")
-          (+cursor-show+ #?"\x1b[?25h"  "Show the cursor.")
-          ;; Colors
-          (+color-BLK+   #?"\x1b[0;30m" "Color BLK.")
-          (+color-RED+   #?"\x1b[0;31m" "Color RED.")
-          (+color-GRN+   #?"\x1b[0;32m" "Color GRN.")
-          (+color-BRN+   #?"\x1b[0;33m" "Color BRN.")
-          (+color-BLU+   #?"\x1b[0;34m" "Color BLU.")
-          (+color-MGN+   #?"\x1b[0;35m" "Color MGN.")
-          (+color-CYA+   #?"\x1b[0;36m" "Color CYA.")
-          (+color-NOR+   #?"\x1b[0;37m" "Color NOR.")
-          (+color-GRA+   #?"\x1b[1;30m" "Color GRA.")
-          (+color-LRD+   #?"\x1b[1;31m" "Color LRD.")
-          (+color-LGN+   #?"\x1b[1;32m" "Color LGN.")
-          (+color-YEL+   #?"\x1b[1;33m" "Color YEL.")
-          (+color-LBL+   #?"\x1b[1;34m" "Color LBL.")
-          (+color-PIN+   #?"\x1b[1;35m" "Color PIN.")
-          (+color-LCY+   #?"\x1b[1;36m" "Color LCY.")
-          (+color-BRI+   #?"\x1b[1;37m" "Color BRI.")
-          (+color-RST+   #?"\x1b[0m"    "Color RST."))))
+(defun view-truncate (line &optional (less 2))
+  (if (> (length line) (- *view-length* less))
+      (subseq line 0 (- *view-length* less))
+      line))
 
 
-;;; Utility functions
-
-(defun clear-terminal ()
-  (format *view-stream* "~a" +term-clear+))
-
-(defun hide-cursor ()
-  (format *view-stream* "~a" +cursor-hide+))
-
-(defun show-cursor ()
-  (format *view-stream* "~a" +cursor-show+))
-
-(defmacro with-line-printing (&rest body)
-  `(unwind-protect
-        (progn (format ,*view-stream* "~a" +set-G1+)
-               (format ,*view-stream* "~a" +b-start+)
-               ,@body)
-     (format ,*view-stream* "~a" +b-stop+)
-     (format ,*view-stream* "~a" +reset-G1+)))
-
-(defmacro with-color-printing (color &rest body)
-  `(unwind-protect
-        (progn (format ,*view-stream* "~a" ,color) ,@body)
-     (format ,*view-stream* "~a" +color-RST+)))
+;;; View functions.
 
 (defun label-line-print (&key (value "") (values)
                            (color +color-RST+) (colors)
@@ -253,21 +147,6 @@ For example a description of the evolution target.")
                                                     :initial-element filler)
                                        (string right)))))))
 
-(defun string-output-stream-p (stream)
-  (typep stream
-         #+sbcl 'sb-impl::string-output-stream
-         #+ccl  'ccl:string-output-stream
-         #- (or sbcl ccl)
-         (error "`string-output-stream-p' only supported for SBCL and CCL")))
-
-(defun view-truncate (line &optional (less 2))
-  (if (> (length line) (- *view-length* less))
-      (subseq line 0 (- *view-length* less))
-      line))
-
-
-;;; View functions.
-
 (defun runtime-print ()
   (if *start-time*
       (label-line-print