Commit 44cad215 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Some debugging of charms input.

parent f1d563b5
......@@ -41,7 +41,7 @@
(defmethod screen-size ((screen charms-screen))
(multiple-value-bind (width height)
(charms:window-dimensions charms:*standard-window*)
(values height width)))
(values height (1- width))))
(defmethod screen-cursor-position ((screen charms-screen))
(charms:cursor-position charms:*standard-window*))
......@@ -75,14 +75,48 @@
(defmethod screen-cursor-off ((screen charms-screen))
)
(defmethod screen-write-string ((screen charms-screen) string)
(loop :for ch :across string
:do (charms:write-char-at-cursor charms:*standard-window* ch))
;; (charms:write-string-at-cursor charms:*standard-window* string)
string)
(defmethod screen-refresh ((screen charms-screen))
(charms:refresh-window charms:*standard-window*))
(defmethod keyboard-chord-no-hang ((screen charms-screen))
(charms:get-char charms:*standard-window* :ignore-errors t))
(let ((ch (charms:get-char charms:*standard-window* :ignore-error t)))
(when ch
(if (find ch #(#\newline #\tab #\esc #\return #\rubout))
(make-instance 'chord :character ch :modifiers 0)
(let* ((code (char-code ch))
(kode (mod code 128))
(controlp (< kode 32))
(metap (< 128 code)))
(make-instance 'chord
:character (code-char (+ kode
(if controlp
(if (< 0 kode 27)
(load-time-value (char-code #\`))
(load-time-value (char-code #\@)))
0)))
:modifiers (+ (if controlp
(expt 2 +control+)
0)
(if metap
(expt 2 +meta+)
0))))))))
(defmethod call-with-screen ((screen charms-screen) thunk)
(charms:with-curses ()
(charms:disable-echoing)
(charms:enable-raw-input :interpret-control-characters nil)
(charms:enable-non-blocking-mode charms:*standard-window*)
(charms:enable-extra-keys charms:*standard-window*) ; keypad t
(charms::check-status (charms/ll:meta (charms::window-pointer charms:*standard-window*) charms/ll:TRUE))
(funcall thunk screen)))
;; (defmethod call-with-current-screen ((screen charms-screen) thunk)
;; )
;;;; THE END ;;;;
......@@ -45,6 +45,19 @@
(defmethod screen-close ((screen clisp-screen))
(close (screen-stream screen)))
(defmethod screen-initialize-for-terminal ((screen clisp-screen) terminal)
(cond
((string= "xterm" terminal)
(setf custom:*terminal-encoding* (ext:make-encoding
:charset charset:iso-8859-1
:line-terminator :unix)))
((string= "kterm" terminal)
(setf custom:*terminal-encoding* (ext:make-encoding
:charset charset:utf-8
:line-terminator :unix)))
(t
(warn "Unexpected terminal ~S" terminal))))
(defmethod screen-size ((screen clisp-screen))
(screen:window-size (screen-stream screen)))
......@@ -81,6 +94,14 @@
(defmethod screen-cursor-off ((screen clisp-screen))
(screen:window-cursor-off (screen-stream screen)))
(defmethod screen-write-string ((screen clisp-screen) string)
(write-string string (screen-stream screen))
(finish-output (screen-stream screen))
string)
(defmethod screen-refresh ((screen clisp-screen))
screen)
(defmethod keyboard-chord-no-hang ((screen clisp-screen))
(declare (ignorable screen))
(let ((ki (ext:with-keyboard (read-char-no-hang ext:*keyboard-input*))))
......@@ -103,20 +124,14 @@
ch))))))
(defmethod call-with-screen ((screen clisp-screen) thunk)
(let ((screen:*window* (screen-stream screen)))
(funcall thunk screen)))
(unwind-protect (screen:with-window
(setf (screen-stream screen) screen:*window*)
(funcall thunk screen))
(setf (screen-stream screen) nil)))
;; (defmethod call-with-current-screen ((screen clisp-screen) thunk)
;; (assert (and screen:*window* (eql screen:*window* (screen-stream screen))))
;; (funcall thunk screen))
(defmethod screen-initialize-for-terminal ((screen clisp-screen) terminal)
(cond
((string= "xterm" terminal)
(setf custom:*terminal-encoding* (ext:make-encoding
:charset charset:iso-8859-1
:line-terminator :unix)))
((string= "kterm" terminal)
(setf custom:*terminal-encoding* (ext:make-encoding
:charset charset:utf-8
:line-terminator :unix)))
(t
(warn "Unexpected terminal ~S" terminal))))
;;;; THE END ;;;;
This diff is collapsed.
......@@ -37,7 +37,8 @@
(:use "COMMON-LISP"
"SPLIT-SEQUENCE"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.DLL"
"COM.INFORMATIMAGO.COMMON-LISP.LISP-SEXP.SOURCE-FORM")
"COM.INFORMATIMAGO.COMMON-LISP.LISP-SEXP.SOURCE-FORM"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.STRING")
(:shadow "DEFUN" "LAMBDA" "ED")
(:export "DEFUN" "LAMBDA" "ED")
(:export "SCREEN-EDITOR" "EDITOR")
......
......@@ -68,6 +68,14 @@ There are methods specialized on these subclasses to write on the screen."))
(defgeneric screen-cursor-off (screen)
(:documentation "Hide the cursor."))
(defgeneric screen-write-string (screen string)
(:documentation "Write the STRING on the SCREEN at the current cursor position."))
(defgeneric screen-format (screen format-control &rest arguments)
(:documentation "Format and write on the Screen at the current cursor position.")
(:method (screen format-control &rest arguments)
(screen-write-string screen (apply (function format) nil format-control arguments))))
(defgeneric screen-refresh (screen))
(defgeneric chord-character (chord))
(defgeneric chord-modifiers (chord))
......@@ -103,16 +111,9 @@ There are methods specialized on these subclasses to write on the screen."))
((character :initarg :character :reader chord-character)
(modifiers :initarg :modifiers :reader chord-modifiers)))
(defgeneric keyboard-chord-no-hang (screen)
(:documentation "Returns the next keyboard chord, or NIL."))
(defgeneric call-with-screen (screen body)
(:documentation "Calls the BODY function with as argument, the SCREEN,
while having activated this screen into the bidimentional mode."))
(defvar *current-screen* nil
......@@ -120,11 +121,29 @@ while having activated this screen into the bidimentional mode."))
one SCREEN instance, but a future version may be ''multitty'' (or
''multiframe'') like GNU emacs.")
(defmacro with-screen (screen-object &body body)
"Executes the BODY with *CURRENT-SCREEN* bound to SCREEN-OBJECT,
while displaying this screen on the terminal."
`(call-with-screen ,screen-object (lambda (*current-screen*) ,@body)))
(defgeneric call-with-screen (screen body)
(:documentation "Calls the BODY function with as argument, the SCREEN,
while having activated this screen into the bidimentional mode.
This methods sets up and terminates the global state of the screen system."))
(defmacro with-screen (SCREEN &body body)
"Executes the BODY with *CURRENT-SCREEN* bound to SCREEN,
while displaying this screen on the terminal.
No other WITH-SCREEN may be called in the BODY. This macros is used
for global setup and termination of the screen system."
`(call-with-screen ,screen (lambda (*current-screen*) ,@body)))
;; (defgeneric call-with-current-screen (screen body)
;; (:documentation "Calls the BODY function with as argument, the SCREEN,
;; while having activated this screen into the bidimentional mode."))
;;
;; (defmacro with-current-screen (SCREEN &body body)
;; "Executes the BODY with *CURRENT-SCREEN* bound to SCREEN,
;; while displaying this screen on the terminal.
;; The screen system must be currently activated with WITH-SCREEN.
;; This macro may be used to switch between alternate subscreens.
;; "
;; `(call-with-current-screen ,screen (lambda (*current-screen*) ,@body)))
;;;; THE END ;;;;
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment