- quit grabbing focus - implement SOH which behaves like line feed - add memory checksum function for unit testing
File modified: lisp/nterm/nterm.el
Change336 at Thu Aug 12 20:03:18 2010 +0200 by Ivan Kanis <ivan@tao>
diff -r 5ad87d1024e4 -r fe9ad24859b6 lisp/nterm/nterm.el --- a/lisp/nterm/nterm.el Thu Aug 12 11:11:21 2010 +0200 +++ b/lisp/nterm/nterm.el Thu Aug 12 20:03:18 2010 +0200 @@ -1,6 +1,6 @@ ;;; nterm.el --- New TERMinal emulator -;; Copyright (C) 2009 Ivan Kanis +;; Copyright (C) 2009, 2010 Ivan Kanis ;; Author: Ivan Kanis <look-for-me@your-favorite-search.engine> ;; Maintainer: Ivan Kanis <look-for-me@your-favorite-search.engine> @@ -121,6 +121,9 @@ list) "Map single width character to unicode double width equivalent.") +(defvar nterm-unit-testing nil + "True when doing unit testing") + ;;; Debugging (defvar nterm-debug-emulator nil) (defvar nterm-debug-vt100 nil) @@ -286,9 +289,10 @@ (if nterm-debug-cursor (message "nterm-cursor-line-set line=%d" cursor-line)) (setcar (cdr (assq 'cursor nterm-state)) cursor-line) - (goto-char 1) - (forward-line cursor-line) - (goto-char (+ (line-beginning-position) (nterm-cursor-col-get)))) + (with-current-buffer nterm-buffer-name + (goto-char 1) + (forward-line cursor-line) + (goto-char (+ (line-beginning-position) (nterm-cursor-col-get))))) (defun nterm-cursor-col-set (cursor-col) "Move cursor to column CURSOR-COL." @@ -297,40 +301,38 @@ (if nterm-debug-cursor (message "nterm-cursor-col-set col=%d" cursor-col)) (setcdr (cdr (assq 'cursor nterm-state)) cursor-col) - (let ((window (get-buffer-window nterm-buffer-name))) - (if window (select-window window) - (switch-to-buffer-other-window nterm-buffer-name))) - (goto-char (+ (line-beginning-position) cursor-col))) + (with-current-buffer nterm-buffer-name + (goto-char (+ (line-beginning-position) cursor-col)))) (defun nterm-emulate (process output) "Dispatch characters from process" - (if nterm-debug-emulator - (message output)) - (if nterm-record-enable - (nterm-record-insert output)) - (let ((emulate-index 0) - (emulate-length (length output)) - (emulate-dispatch nil) - (emulate-char ?0) - (emulate-buffer (current-buffer))) - (set-buffer nterm-buffer-name) - (while (< emulate-index emulate-length) - (setq emulate-char (aref output emulate-index)) - (if (< emulate-char (length (eval nterm-dispatch))) - (progn - (setq emulate-dispatch (aref (eval nterm-dispatch) emulate-char)) - (if emulate-dispatch - (progn - (if nterm-debug-emulator - (message "received 0x%x %c dispatch %S" - emulate-char emulate-char emulate-dispatch)) - (funcall emulate-dispatch emulate-char) - (if nterm-debug-assert - (nterm-assert))) - (if nterm-debug-emulator - (message "received 0x%x not handled" emulate-char))))) - (incf emulate-index)) - (set-buffer emulate-buffer))) + (with-current-buffer nterm-buffer-name + (if nterm-debug-emulator + (message output)) + (if nterm-record-enable + (nterm-record-insert output)) + (let ((emulate-index 0) + (emulate-length (length output)) + (emulate-dispatch nil) + (emulate-char ?0) + (emulate-buffer (current-buffer))) + (set-buffer nterm-buffer-name) + (while (< emulate-index emulate-length) + (setq emulate-char (aref output emulate-index)) + (if (< emulate-char (length (eval nterm-dispatch))) + (progn + (setq emulate-dispatch (aref (eval nterm-dispatch) emulate-char)) + (if emulate-dispatch + (progn + (if nterm-debug-emulator + (message "received 0x%x %c dispatch %S" + emulate-char emulate-char emulate-dispatch)) + (funcall emulate-dispatch emulate-char) + (if nterm-debug-assert + (nterm-assert))) + (if nterm-debug-emulator + (message "received 0x%x not handled" emulate-char))))) + (incf emulate-index))))) (defun nterm-init () (setq nterm-state @@ -391,13 +393,15 @@ Entry to this mode runs the hooks on `nterm-mode-hook'." (interactive) (get-buffer-create nterm-buffer-name) - (pop-to-buffer nterm-buffer-name) - (kill-all-local-variables) - (set (make-local-variable 'nterm-process) - (get-buffer-process (current-buffer))) - (set (make-local-variable 'nterm-argument) "") - (setq mode-name "nterm") - (setq major-mode 'nterm-mode) + (when (not nterm-unit-testing) + (pop-to-buffer nterm-buffer-name) + (kill-all-local-variables) + (set (make-local-variable 'nterm-process) + (get-buffer-process (current-buffer))) + (setq mode-name "nterm") + (setq major-mode 'nterm-mode)) + (with-current-buffer nterm-buffer-name + (set (make-local-variable 'nterm-argument) "")) (setq truncate-lines t) (buffer-disable-undo nil) (nterm-init) @@ -405,21 +409,22 @@ (nterm-vt100-init) (nterm-vt100-switch) (nterm-blank-screen) - (let* ((process-environment - (nconc - (list - (format "TERM=vt100")) process-environment)) - (process-connection-type t) - (inhibit-eol-conversion t) - (coding-system-for-read 'binary) - (process - (start-process - nterm-shell nterm-buffer-name - nterm-shell "-c" - (format "stty -nl echo rows %d columns %d sane ; exec %s" - nterm-height nterm-width nterm-shell)))) - (set-process-filter process 'nterm-emulate)) - (run-hooks 'nterm-mode-hook)) + (when (not nterm-unit-testing) + (let* ((process-environment + (nconc + (list + (format "TERM=vt100")) process-environment)) + (process-connection-type t) + (inhibit-eol-conversion t) + (coding-system-for-read 'binary) + (process + (start-process + nterm-shell nterm-buffer-name + nterm-shell "-c" + (format "stty -nl echo rows %d columns %d sane ; exec %s" + nterm-height nterm-width nterm-shell)))) + (set-process-filter process 'nterm-emulate)) + (run-hooks 'nterm-mode-hook))) (defun nterm-scroll-up (top bottom blank-line-function) "Scroll screen up from TOP to BOTTOM. @@ -795,6 +800,7 @@ (nterm-defdispatch ; Primary dispatch of a VT100 '(nterm-vt100-primary-dispatch 128 nterm-vt100-char-self + ? nterm-vt100-soh ? nterm-vt100-so ? nterm-vt100-si ?\a nterm-vt100-bel @@ -1101,12 +1107,8 @@ (defun nterm-vt100-char-self (char) "Insert character from output. Take care of wrapping." - ;; focus - (let ((self-window (get-buffer-window nterm-buffer-name)) - (self-width (nterm-vt100-width)) + (let ((self-width (nterm-vt100-width)) (self-col (nterm-cursor-col-get))) - (if self-window (select-window self-window) - (switch-to-buffer-other-window nterm-buffer-name)) ;; wrapping (if (and (nterm-vt100-mode-decawm) (cdr (assq 'wrap nterm-vt100-state)) @@ -1122,7 +1124,6 @@ (defun nterm-vt100-cr (char) "Do a carriage return" - (interactive) (if nterm-debug-vt100 (message "CR")) (nterm-cursor-col-set 0)) @@ -1546,25 +1547,27 @@ (defun nterm-vt100-line-draw (&optional line) "Draw LINE from terminal memory." - (or line - (setq line (nterm-cursor-line-get))) - (let ((draw-index 0) - (draw-cur (nterm-cursor-position-get))) - (nterm-cursor-position-set (cons line 0)) - (nterm-kill-line) - (let* ((draw-dwl (nterm-mem-line-dwl)) - (draw-end (nterm-vt100-width))) - (while (< draw-index draw-end) - (let ((res (nterm-vt100-line-draw-attribute line draw-index draw-dwl))) - (if draw-dwl - (nterm-vt100-line-draw-dwl res) - (insert (cdr (assq 'char res))) - (remove-text-properties (- (point) 1) (point) '(face)) - (put-text-property (- (point) 1) (point) 'face - (cdr (assq 'face res))))) - (incf draw-index))) - (insert "\n") - (nterm-cursor-position-set draw-cur))) + (with-current-buffer nterm-buffer-name + (or line + (setq line (nterm-cursor-line-get))) + (let ((draw-index 0) + (draw-cur (nterm-cursor-position-get))) + (nterm-cursor-position-set (cons line 0)) + (nterm-kill-line) + (let* ((draw-dwl (nterm-mem-line-dwl)) + (draw-end (nterm-vt100-width))) + (while (< draw-index draw-end) + (let ((res (nterm-vt100-line-draw-attribute + line draw-index draw-dwl))) + (if draw-dwl + (nterm-vt100-line-draw-dwl res) + (insert (cdr (assq 'char res))) + (remove-text-properties (- (point) 1) (point) '(face)) + (put-text-property (- (point) 1) (point) 'face + (cdr (assq 'face res))))) + (incf draw-index))) + (insert "\n") + (nterm-cursor-position-set draw-cur)))) (defun nterm-vt100-line-draw-attribute (line draw-index draw-dwl) "TBD document me." @@ -1795,6 +1798,13 @@ (setcdr (assq 'current-charset nterm-vt100-state) 1) (nterm-vt100-set-attribute)) +(defun nterm-vt100-soh (char) + "Do a start of heading" + (if nterm-debug-vt100 + (message "SOH")) + ;; behaves like a line feed + (nterm-vt100-lf char)) + (defun nterm-vt100-sm (char) "SM -- Set Mode - host to vt100" (if nterm-debug-vt100 @@ -1805,7 +1815,8 @@ (defun nterm-vt100-switch () "Switch to vt100." - (use-local-map nterm-vt100-mode-map) + (if (not nterm-unit-testing) + (use-local-map nterm-vt100-mode-map)) (setq nterm-dispatch 'nterm-vt100-primary-dispatch)) (defun nterm-vt100-tab (char) @@ -2430,7 +2441,8 @@ (nterm-vt100-escape-end char)) (defun nterm-vt52-switch () - (setq nterm-dispatch 'nterm-vt52-primary-dispatch) + (if (not nterm-unit-testing) + (setq nterm-dispatch 'nterm-vt52-primary-dispatch)) (use-local-map nterm-vt52-mode-map)) (defun nterm-vt52-identify (char) @@ -2539,7 +2551,6 @@ (pop-to-buffer nterm-mem-buffer) (nterm-mem-mode)) - (defun nterm-mem-attribute () "Return a cell of attribute." (make-bool-vector 6 nil)) @@ -2589,6 +2600,11 @@ "Return attribute value at LINE" (cdr (assq 'line-attr (nth line nterm-memory)))) +(defun nterm-mem-checksum () + (with-temp-buffer + (nterm-mem-dump) + (md5 (current-buffer)))) + (defun nterm-mem-vector-to-dec (vector) (let ((vector-index 0) (vector-base 1) @@ -2813,9 +2829,6 @@ ;;; Copyright crap -;; Copyright (C) 2009 Ivan Kanis -;; Author: Ivan Kanis -;; ;; This program is free software ; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation ; either version 2 of the License, or