87 lines
4.5 KiB
Common Lisp
87 lines
4.5 KiB
Common Lisp
(load "~/quicklisp/setup.lisp")
|
|
(ql:register-local-projects)
|
|
(ql:quickload :cl-tty :silent t)
|
|
|
|
(defun test (label sexp)
|
|
(let ((tmp "/tmp/binary-test.lisp"))
|
|
(with-open-file (out tmp :direction :output :if-exists :supersede)
|
|
(format out "(in-package :cl-tty.input)~%")
|
|
(write sexp :stream out :case :upcase)
|
|
(terpri out))
|
|
(multiple-value-bind (fasl warn-p fail-p)
|
|
(compile-file tmp :print nil :verbose nil)
|
|
(format t "~a: warn=~a fail=~a~%" label warn-p fail-p)
|
|
(when (and fasl (probe-file fasl)) (delete-file fasl))
|
|
(delete-file tmp))))
|
|
|
|
;; Fix 1: use cond with (eql ...) instead of case
|
|
(test "FIX1-cond"
|
|
'(defun %read-escape-sequence ()
|
|
(multiple-value-bind (b reason) (read-raw-byte :timeout 0.05)
|
|
(unless b
|
|
(return-from %read-escape-sequence
|
|
(if (eq reason :eof) :eof
|
|
(make-key-event :key :escape :raw (string #\Esc)))))
|
|
(cond
|
|
((eql b #x4f)
|
|
(let ((b2 (read-raw-byte)))
|
|
(if b2
|
|
(let ((key (cdr (assoc (code-char b2)
|
|
'((#\P . :f1) (#\Q . :f2)
|
|
(#\R . :f3) (#\S . :f4))))))
|
|
(make-key-event :key (or key :unknown)
|
|
:raw (format nil "~C~C~C" #\Esc #\O (code-char b2))))
|
|
:eof)))
|
|
((eql b #x5b)
|
|
(multiple-value-bind (params final-byte raw) (parse-csi-params)
|
|
(cond
|
|
((null final-byte)
|
|
(if (eq raw :eof) :eof
|
|
(make-key-event :key :escape :raw (string #\Esc))))
|
|
((and raw (plusp (length raw)) (char= (char raw 0) #\<))
|
|
(or (parse-sgr-mouse raw)
|
|
(make-key-event :key :unknown :raw raw)))
|
|
((and (char= (code-char final-byte) #\M) (>= (length params) 3))
|
|
(let* ((p0 (first params)))
|
|
(if (zerop (logand p0 #x40))
|
|
(let* ((x (second params))
|
|
(y (third params))
|
|
(button (logand p0 #x03))
|
|
(motion (logand p0 #x20))
|
|
(release (= button 3)))
|
|
(make-mouse-event
|
|
:type (cond (release :release) (motion :drag) (t :press))
|
|
:button (let ((b button)) (cond ((= b 0) :left) ((= b 1) :middle) ((= b 2) :right) (t :none)))
|
|
:x x :y y :raw (format nil "~C[<~d;~d;~d~C" #\Esc p0 x y (code-char final-byte))))
|
|
(let* ((tilde-p (char= (code-char final-byte) #\~))
|
|
(param (or p0 0))
|
|
(key (if tilde-p (cdr (assoc param *csi-tilde-table*)) (cdr (assoc (code-char final-byte) *csi-key-table*))))
|
|
(modifier (when (> (length params) 1) (second params))))
|
|
(let ((ctrl nil) (alt nil) (shift nil))
|
|
(when modifier
|
|
(setf shift (logtest modifier 1) alt (logtest modifier 2) ctrl (logtest modifier 4)))
|
|
(make-key-event :key (or key :unknown) :ctrl ctrl :alt alt :shift shift
|
|
:raw (format nil "~C[~d~C" #\Esc param (code-char final-byte))))))))
|
|
(t
|
|
(let* ((tilde-p (char= (code-char final-byte) #\~))
|
|
(param (or (first params) 0))
|
|
(key (if tilde-p (cdr (assoc param *csi-tilde-table*)) (cdr (assoc (code-char final-byte) *csi-key-table*))))
|
|
(modifier (when (> (length params) 1) (second params))))
|
|
(let ((ctrl nil) (alt nil) (shift nil))
|
|
(when modifier
|
|
(setf shift (logtest modifier 1) alt (logtest modifier 2) ctrl (logtest modifier 4)))
|
|
(make-key-event :key (or key :unknown) :ctrl ctrl :alt alt :shift shift
|
|
:raw (format nil "~C[~d~C" #\Esc param (code-char final-byte)))))))))
|
|
((eql b #x1b)
|
|
(make-key-event :key :escape :alt t :raw "\\\\e\\\\e"))
|
|
(t
|
|
(let ((ch (code-char b)))
|
|
(if (and (>= b #x20) (<= b #x7e))
|
|
(make-key-event :key (intern (string (string-upcase ch)) :keyword)
|
|
:alt t
|
|
:raw (format nil "~C~C" #\Esc ch))
|
|
(make-key-event :key :unknown
|
|
:raw (format nil "~C~C" #\Esc ch)))))))))
|
|
|
|
(uiop:quit)
|