Commit f1d563b5 authored by Pascal J. Bourguignon's avatar Pascal J. Bourguignon

Extracted screen and implementation dependant code to separate files.

parent fbec4e18
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: charm-screen.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; Implements a SCREEN using CL-CHARMS.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-01-11 <PJB> Extracted from editor.lisp
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(in-package "COM.INFORMATIMAGO.EDITOR")
(defclass charms-screen (screen)
()
(:documentation "This SCREEN subclass uses cl-charms (ncurses)."))
(defmethod screen-size ((screen charms-screen))
(multiple-value-bind (width height)
(charms:window-dimensions charms:*standard-window*)
(values height width)))
(defmethod screen-cursor-position ((screen charms-screen))
(charms:cursor-position charms:*standard-window*))
(defmethod set-screen-cursor-position ((screen charms-screen) line column)
(charms:move-cursor charms:*standard-window* column line))
(defmethod clear-screen-to-eot ((screen charms-screen))
(charms:clear-window-after-cursor charms:*standard-window*))
(defmethod clear-screen-to-eol ((screen charms-screen))
(charms:clear-line-after-cursor charms:*standard-window*))
(defmethod delete-screen-line ((screen charms-screen))
;; (charms/ll:deleteln)
)
(defmethod insert-screen-line ((screen charms-screen))
;; (charms/ll:insertln)
)
(defmethod screen-highlight-on ((screen charms-screen))
)
(defmethod screen-highlight-off ((screen charms-screen))
)
(defmethod screen-cursor-on ((screen charms-screen))
)
(defmethod screen-cursor-off ((screen charms-screen))
)
(defmethod keyboard-chord-no-hang ((screen charms-screen))
(charms:get-char charms:*standard-window* :ignore-errors t))
(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*)
(funcall thunk screen)))
;;;; THE END ;;;;
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: clisp-screen.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; Implements a SCREEN using clisp screen package.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-01-11 <PJB> Extracted from editor.
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(in-package "COM.INFORMATIMAGO.EDITOR")
(defclass clisp-screen (screen)
((stream :reader screen-stream :initform (screen:make-window)))
(:documentation "This SCREEN subclass uses the CLISP SCREEN package."))
(defmethod screen-open ((screen clisp-screen))
(setf (screen-stream screen) (screen:make-window)))
(defmethod screen-close ((screen clisp-screen))
(close (screen-stream screen)))
(defmethod screen-size ((screen clisp-screen))
(screen:window-size (screen-stream screen)))
(defmethod screen-cursor-position ((screen clisp-screen))
(screen:window-cursor-position (screen-stream screen)))
(defmethod set-screen-cursor-position ((screen clisp-screen) line column)
(screen:set-window-cursor-position (screen-stream screen) line column))
(defmethod clear-screen ((screen clisp-screen))
(screen:clear-window (screen-stream screen)))
(defmethod clear-screen-to-eot ((screen clisp-screen))
(screen:clear-window-to-eot (screen-stream screen)))
(defmethod clear-screen-to-eol ((screen clisp-screen))
(screen:clear-window-to-eol (screen-stream screen)))
(defmethod delete-screen-line ((screen clisp-screen))
(screen:delete-window-line (screen-stream screen)))
(defmethod insert-screen-line ((screen clisp-screen))
(screen:insert-window-line (screen-stream screen)))
(defmethod screen-highlight-on ((screen clisp-screen))
(screen:highlight-on (screen-stream screen)))
(defmethod screen-highlight-off ((screen clisp-screen))
(screen:highlight-off (screen-stream screen)))
(defmethod screen-cursor-on ((screen clisp-screen))
(screen:window-cursor-on (screen-stream screen)))
(defmethod screen-cursor-off ((screen clisp-screen))
(screen:window-cursor-off (screen-stream screen)))
(defmethod keyboard-chord-no-hang ((screen clisp-screen))
(declare (ignorable screen))
(let ((ki (ext:with-keyboard (read-char-no-hang ext:*keyboard-input*))))
(when ki
(make-instance
'chord
:modifiers (loop
:with bits = (ext:char-bits ki)
:for (bit modifier)
:in (load-time-value
(list (list EXT:CHAR-CONTROL-BIT +control+)
(list EXT:CHAR-META-BIT +meta+)
(list EXT:CHAR-SUPER-BIT +super+)
(list EXT:CHAR-HYPER-BIT +hyper+)))
:when (logand bits bit)
:sum (expt 2 modifier))
:character (let ((ch (or (ext:char-key ki) (character ki))))
(if (ext:char-bit ki :control)
(char-downcase ch)
ch))))))
(defmethod call-with-screen ((screen clisp-screen) thunk)
(let ((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 ;;;;
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: clisp.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; clisp specific functions.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-01-11 <PJB> Extracted from editor.lisp
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(in-package "COM.INFORMATIMAGO.EDITOR")
(defun make-xterm-io-stream (&key display geometry)
(let* ((pipe (with-open-stream (s (ext:make-pipe-input-stream
"mktemp /tmp/clisp-x-io-XXXXXX"))
(read-line s)))
(title "CLISP I/O")
;; (clos::*warn-if-gf-already-called* nil)
(font nil
#+(or) "-*-console-medium-r-normal-*-16-*-*-*-*-*-*-*"
#+(or)"-dec-terminal-bold-r-normal-*-14-*-*-*-*-*-dec-dectech"))
;; xterm creates a pty, forks, hooks the pty to stdin/stdout
;; and exec bash with the commands given in -e.
;; We write this pty path to our pipe,
;; and cat our pipe to wait for the end.
;; Meanwhile, we'll be reading and writing this pty.
(ext:shell (format nil "rm -f ~S; mknod ~S p; xterm ~
~:[~;~:*-geometry ~S~] ~:[~;~:*-display ~S~] ~
-fg green -bg black ~:[~;~:*-fn '~A'~] -n ~S -T ~S ~
-e 'tty >> ~S ; cat ~S' &"
pipe pipe geometry display font title title pipe pipe))
(let* ((tty-name (with-open-file (s pipe) (read-line s)))
(xio (make-two-way-stream
(open tty-name :direction :input :buffered nil)
(open tty-name :direction :output :buffered nil))))
(system::terminal-raw (two-way-stream-input-stream xio) t t)
(defmethod close :after ((x (eql xio)) &rest junk)
(declare (ignore x junk))
(ignore-errors
(with-open-file (s pipe :direction :output)
(write-line "Bye." s)))
(delete-file pipe)
(close (two-way-stream-input-stream xio))
(close (two-way-stream-output-stream xio))
(let () ;; ((clos::*warn-if-gf-already-called* nil))
(remove-method #'close (find-method #'close '(:after) `((eql ,xio))))))
xio)))
(defun screen-editor (&key log)
(cond
((string= "xterm" (uiop/os:getenv "TERM"))
(setf custom:*terminal-encoding* (ext:make-encoding
:charset charset:iso-8859-1
:line-terminator :unix)))
((string= "kterm" (uiop/os:getenv "TERM"))
(setf custom:*terminal-encoding* (ext:make-encoding
:charset charset:utf-8
:line-terminator :unix))))
(editor-reset)
(let ((*log* (typecase log
((member :xterm) (make-xterm-io-stream :geometry "100x24+0+0"))
((or string pathname) (open log
:direction :output
:if-exists :append
:if-does-not-exist :create))
(file log)
(otherwise (make-broadcast-stream)))))
(unwind-protect
(with-open-screen (make-instance 'clisp-screen)
(editor-initialize *current-screen*)
(unwind-protect
(keyboard-loop)
(set-screen-cursor-position *current-screen*
0 (screen-size *current-screen*))
(clear-screen *current-screen*))
(editor-terminate))
(close *log*))))
(defun keyboard-test ()
(screen:with-window nil
(screen:set-window-cursor-position screen:*window* 2 10)
(format t "Hi")
(EXT:WITH-KEYBOARD
(LOOP
:for ki = (READ-CHAR EXT:*KEYBOARD-INPUT*)
:do
(print ki)
(print `((ext:char-key ki) ,(ext:char-key ki)))
(print `((character ki)
,(and (not (ext:char-key ki))
(zerop (ext:char-bits ki))
(character ki))))
(print `((ext:char-font ki) ,(ext:char-font ki)))
(print `((ext:char-bits ki) ,(ext:char-bits ki)))
(dolist (modifier '(:control :meta :super :hyper))
(print `((ext:char-bit ki ,modifier) ,(ext:char-bit ki modifier))))
(finish-output)
:until (EQL (and (not (ext:char-key ki))
(zerop (ext:char-bits ki))
(character ki)) #\q)))))
(defun xexample (&key (display ":0.0"))
(let* ((old-terminal-io *terminal-io*)
(xterm-io (make-xterm-io-stream :display display :geometry "+0+0"))
(*terminal-io* xterm-io)
(*standard-output* (make-synonym-stream '*terminal-io*))
(*standard-input* (make-synonym-stream '*terminal-io*))
(*error-output* (make-synonym-stream '*terminal-io*))
(*query-io* (make-synonym-stream '*terminal-io*))
;; (*debug-io* (make-synonym-stream '*terminal-io*))
;; (*trace-output* (make-synonym-stream '*terminal-io*))
(old-term (uiop/os:getenv "TERM")))
(setf (uiop/os:getenv "TERM") "xterm")
(unwind-protect
(progn (format *query-io* "~&Hello!~%")
(format *query-io* "~&X = ")
(finish-output *query-io*)
(let ((x (read *query-io*)))
(format *query-io* "~&~S = ~A~%" '(- (* 2 x) 3) (- (* 2 x) 3)))
(y-or-n-p "Happy?"))
(setf *terminal-io* old-terminal-io)
(close xterm-io)
(setf (uiop/os:getenv "TERM") old-term))))
;;;; THE END ;;;;
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: editor.asd
;;;;FILE: com.informatimago.editor.asd
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
......@@ -33,20 +33,30 @@
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(asdf:defsystem :com.informatimago.future.editor
:name "com.informatimago.future.editor"
:description "Editor tools."
(asdf:defsystem :com.informatimago.editor
:name "com.informatimago.editor"
:description "An emacs-like editor."
:author "Pascal J. Bourguignon"
:version "1.0.3"
:license "GPL3"
:version "1.0.4"
:license "AGPL3"
:depends-on ("com.informatimago.common-lisp.cesarum"
"com.informatimago.common-lisp.lisp-sexp"
"split-sequence"
"cl-charms")
:components ((:file "editor")))
#-clisp (eval-when (:compile-toplevel :load-toplevel :execute)
(warn "System ~A is not available on ~A yet."
:com.informatimago.future.editor (lisp-implementation-type)))
:components ((:file "package")
(:file "macros" :depends-on ("package"))
(:file "screen" :depends-on ("package"
"macros"))
#+clisp (:file "clisp-screen" :depends-on ("package"
"macros" "screen"))
#+clisp (:file "clisp" :depends-on ("package"
"macros" "screen"
"clisp-screen"))
(:file "charms-screen" :depends-on ("package"
"macros" "screen"))
(:file "editor" :depends-on ("package"
"macros" "screen"
#+clisp "clisp"
"charms-screen"))))
;;;; THE END ;;;;
This diff is collapsed.
;;; -- not used --
(in-package "COMMON-LISP-USER")
;; while debugging:
#-(and)
(when (find-package "COM.INFORMATIMAGO.EDITOR")
(delete-package "COM.INFORMATIMAGO.EDITOR"))
;;;---------------------------------------------------------------------
;;;
;;; We put on *FEATURES* a keyword representing the language to use for
;;; documentation strings:
;;;
(defvar *languages* '((:DK . :DANSK)
(:DE . :DEUTSCH)
(:EN . :ENGLISH)
(:ES . :ESPAÑOL)
(:FR . :FRANÇAIS)
(:NL . :NEDERLANDS)
(:RU . :РУССКИЙ))
"Maps the language code (in keyword) as used in the LANG environment variable,
to language names (as keyword).")
;; Remove the old languages, if any.
(setf *features* (set-difference *features* (mapcar (function cdr) *languages*)))
;; Push the new language. By default we use :ENGLISH.
(pushnew (progn
;; In clisp, we use the custom:*current-language* variable:
#+clisp (intern (string custom:*current-language*) "KEYWORD")
;; Otherwise if we have ASDF, we try to get the environment variable LANG:
#+(and (not clisp) asdf)
(let* ((lang #-asdf3 (ASDF:GETENV "LANG")
#+asdf3 (uiop/os:getenv "LANG"))
(entry (assoc lang *languages* :test (function string-equal))))
(if entry
(cdr entry)
:english))
;; otherwise we use English:
#-(or clisp asdf) :english)
*features*)
;;; In any case, if we don't have the documentation in the selected
;;; language, we fall back to docstrings in English.
;;;
;;;---------------------------------------------------------------------
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: macros.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; Defines DEFUN and LAMBDA, to deal with interactive declarations.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-01-11 <PJB> Extracted from editor.lisp
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(in-package "COM.INFORMATIMAGO.EDITOR")
;;;---------------------------------------------------------------------
;;; Commands: interactive functions
;;;---------------------------------------------------------------------
;;;
;;; We want to define commands, with a special INTERACTIVE
;;; declaration. So we need to use our own DEFUN (and LAMBDA) macros.
(declaim (declaration interactive))
(defvar *interactive-decls* (make-hash-table #+clisp :weak #+clisp :key)
"A map of commands name or functions to INTERACTIVE declarations.")
(defmacro defun (name arguments &body body)
"Do additionnal book-keeping over CL:DEFUN, for INTERACTIVE commands."
(let* ((decls (mapcan (function rest) (extract-declarations body)))
(inter (find 'interactive decls :key (function first))))
(if inter
`(progn
(compile (cl:defun ,name ,arguments ,@body))
(setf (gethash ',name *interactive-decls*) ',inter
(gethash (function ,name) *interactive-decls*) ',inter)
',name)
`(progn
(cl:defun ,name ,arguments ,@body)
(remhash ',name *interactive-decls*)
(remhash (function ,name) *interactive-decls*)
',name))))
(defmacro lambda (arguments &body body)
"Do additionnal bookkeeping over CL:LAMBDA, for INTERACTIVE commands."
(let* ((decls (mapcan (function rest) (extract-declarations body)))
(inter (find 'interactive decls :key (function first))))
(if inter
`(progn
(let ((fun (compile nil '(cl:lambda ,arguments ,@body))))
(setf (gethash fun *interactive-decls*) ',inter)
fun))
`(cl:lambda ,arguments ,@body))))
(defun interactivep (fundesc)
"Whether the function FUNCDESC is INTERACTIVE."
(gethash fundesc *interactive-decls*))
;;;; THE END ;;;;
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: package.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; Defines the editor package.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-01-11 <PJB> Extracted from editor.lisp
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(defpackage "COM.INFORMATIMAGO.EDITOR"
(:nicknames "EDITOR" "EMACS" "E")
(:use "COMMON-LISP"
"SPLIT-SEQUENCE"
"COM.INFORMATIMAGO.COMMON-LISP.CESARUM.DLL"
"COM.INFORMATIMAGO.COMMON-LISP.LISP-SEXP.SOURCE-FORM")
(:shadow "DEFUN" "LAMBDA" "ED")
(:export "DEFUN" "LAMBDA" "ED")
(:export "SCREEN-EDITOR" "EDITOR")
(:documentation "
An emacs-like editor written in Common Lisp.
Copyright Pascal J. Bourguignon 2006 - 2015
AGPL3
This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU Affero General Public License for more details.
You should have received a copy of the GNU Affero General Public License
along with this program. If not, see <http://www.gnu.org/licenses/>.
"))
;;;; THE END ;;;;
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE: screen.lisp
;;;;LANGUAGE: Common-Lisp
;;;;SYSTEM: Common-Lisp
;;;;USER-INTERFACE: NONE
;;;;DESCRIPTION
;;;;
;;;; Defines the SCREEN interface.
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;; 2015-01-11 <PJB> Extracted from editor.lisp
;;;;BUGS
;;;;LEGAL
;;;; AGPL3
;;;;
;;;; Copyright Pascal J. Bourguignon 2015 - 2015
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Affero General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Affero General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Affero General Public License
;;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;;**************************************************************************
(in-package "COM.INFORMATIMAGO.EDITOR")
;;;---------------------------------------------------------------------
;;; Screen interface
;;;---------------------------------------------------------------------
(defclass screen ()
((stream :reader screen-stream))
(:documentation "This object represents the screen.
There are subclasses specific to each available screen device.
There are methods specialized on these subclasses to write on the screen."))
(defgeneric screen-open (screen))
(defgeneric screen-close (screen))
(defgeneric screen-initialize-for-terminal (screen terminal)
(:method ((screen screen) terminal) terminal))
(defgeneric screen-size (screen))
(defgeneric screen-cursor-position (screen))
(defgeneric set-screen-cursor-position (screen line column))
(defgeneric clear-screen (screen)
(:method ((screen screen))
(set-screen-cursor-position screen 0 0)
(clear-screen-to-eot screen)))
(defgeneric clear-screen-to-eot (screen))
(defgeneric clear-screen-to-eol (screen))
(defgeneric delete-screen-line (screen))
(defgeneric insert-screen-line (screen))
(defgeneric screen-highlight-on (screen))
(defgeneric screen-highlight-off (screen))
(defgeneric screen-cursor-on (screen)
(:documentation "Show up the cursor."))
(defgeneric screen-cursor-off (screen)
(:documentation "Hide the cursor."))
(defgeneric chord-character (chord))
(defgeneric chord-modifiers (chord))
(defgeneric chord-modifierp (chord modifier)
(:method (chord (modifier integer))
(logbitp modifier (chord-modifiers chord)))
(:method (chord (modifier symbol))
(chord-modifierp chord (ecase modifier
(:shift +shift+)
(:control +control+)
(:meta +meta+)
(:alt +alt+)
(:super +super+)
(:hyper +hyper+)
(:command +command+)))))
(defconstant +shift+ 0)
(defconstant +control+ 1)
(defconstant +meta+ 2)
(defconstant +alt+ 3)
(defconstant +super+ 4)
(defconstant +hyper+ 5)
(defconstant +command+ 6)
(defun symbolic-modifiers (modifiers)
(loop
:for bit = 1 :then (* 2 bit)
:for modifier :in '(:shift :control :meta :alt :super :hyper :command)
:unless (zerop (logand bit modifiers)) :collect modifier))
(defclass chord ()
((character :initarg :character :reader chord-character)
(modifiers :initarg :modifiers :reader chord-modifiers)))