; -*- Mode:LISP; Package:STEVE; Readtable:CL; Base:10 -*-
; (C) Copyright 1983 Christopher Eliot & Massachusetts Institute of Technology.

(defvar auto-digit-arg-save nil)
(defvar auto-digit-save 0)

(editor-bind-key #\control-u (universal-argument))

(defun universal-argument (foo &aux val1 val2)
 (with-notify-line
  (when (argument?)
   (format terminal-io "^U ~a " *argument*))
  (princ "^U " terminal-io)
  (let ((char (peek-char&save terminal-io)))
   (when (char= char #\^g)
     (ed-abort :echo))
   (cond ((char= char #\-)
	  (send terminal-io :write-char char)
	  (read-char&save terminal-io)
	  (setq *argument* (minus *argument*)
		char (peek-char&save terminal-io))
	  (when (char= char #\^g)
	    (ed-abort :echo))
	  (cond ((not (ed-digit-charp char))
		 (princ "1" terminal-io))
		(t (setq *argument* (times (read-argument-number) *argument*)
			 argument-supplied? t))))
	 ((not (ed-digit-charp char))
	  (setq *argument* (times 4 *argument*))
	  (princ "4" terminal-io))
	 (t (setq *argument* (times (read-argument-number) *argument*)
		  argument-supplied? t))))
  (multiple-value (val1 val2) (read-key)))
 (values val1 val2))

(defsubst ed-digit-charp (char)
  (if (%digit-char-in-radixp char 10)
      (%digit-char-to-weight char)))

(defun read-positive-number (&optional (first (read-char&save terminal-io))
			     &aux (value 0))
  (loop for char first first then (read-char&save terminal-io)
	if (char= #\^g char) 
          do (ed-abort :echo)
	while (ed-digit-charp char)
	  do (progn (send terminal-io :write-char char)
		    (setq value (plus (ed-digit-charp char) (times value 10))))
	finally (unread-char&save char terminal-io)
	finally (return value)))

(defun read-argument-number (&aux (first-digit (read-char&save terminal-io)))
  (when (char= first-digit #\^g) (ed-abort :echo))
  (cond ((char= first-digit #\-)
	 (write-char #\-)
	 (-& (read-positive-number)))
	(t (unread-char&save first-digit terminal-io)
	   (read-positive-number))))

(editor-bind-key #\meta-- (auto-negative-digit))

(defun auto-negative-digit (foo &aux val1 val2)
 (with-notify-line
  (when (argument?)
   (format terminal-io "^U ~a " *argument*))
  (princ " - " terminal-io)
  (setq argument-supplied? t)
  (if (not (ed-digit-charp (peek-char&save terminal-io)))
      (setq *argument* (minus *argument*))
      (setq *argument* (times (minus (read-positive-number)) *argument*)))
  (multiple-value (val1 val2) (read-key)))
 (values val1 val2))

(editor-bind-key #\meta-0 (auto-argument 0))

(defun auto-argument (foo digit &aux val1 val2)
 (with-notify-line
  (when (argument?)
   (format terminal-io "^U ~a " *argument*))
  (princ "M " terminal-io)
  (setq *argument* (times *argument* (read-positive-number
				      (%digit-weight-to-char digit)))
	argument-supplied? t)
  (multiple-value (val1 val2) (read-key)))
 (values val1 val2))

(editor-bind-key #\meta-1 (auto-argument 1))
(editor-bind-key #\meta-2 (auto-argument 2))
(editor-bind-key #\meta-3 (auto-argument 3))
(editor-bind-key #\meta-4 (auto-argument 4))
(editor-bind-key #\meta-5 (auto-argument 5))
(editor-bind-key #\meta-6 (auto-argument 6))
(editor-bind-key #\meta-7 (auto-argument 7))
(editor-bind-key #\meta-8 (auto-argument 8))
(editor-bind-key #\meta-9 (auto-argument 9))

(editor-bind-key #\control-- (negative-argument))
(editor-bind-key #\control-meta-- (negative-argument))

(defun negative-argument (foo &aux val1 val2)
 (with-notify-line
  (when (argument?)
   (format terminal-io "^U ~a " *argument*))
  (princ " C- " terminal-io)
  (setq auto-digit-arg-save (minus *argument*)
	auto-digit-save 0
	*argument* (minus *argument*)
	argument-supplied? t)
 (multiple-value (val1 val2) (read-key)))
 (values val1 val2))

(defun argument-digit (foo digit &aux val1 val2)
 (with-notify-line
  (if (argument?)
      (format terminal-io "^U ~a" *argument*)
      (princ "C " terminal-io))
  (when (null auto-digit-arg-save)
   (setq auto-digit-arg-save *argument*
	 auto-digit-save 0))
  (setq auto-digit-save
	(plus digit
	      (times auto-digit-save 10))
	*argument* (times auto-digit-save auto-digit-arg-save)
	argument-supplied? t)
  (princ digit terminal-io)
  (multiple-value (val1 val2) (read-key)))
 (values val1 val2))

(editor-bind-key #\control-0 (argument-digit 0))
(editor-bind-key #\control-1 (argument-digit 1))
(editor-bind-key #\control-2 (argument-digit 2))
(editor-bind-key #\control-3 (argument-digit 3))
(editor-bind-key #\control-4 (argument-digit 4))
(editor-bind-key #\control-5 (argument-digit 5))
(editor-bind-key #\control-6 (argument-digit 6))
(editor-bind-key #\control-7 (argument-digit 7))
(editor-bind-key #\control-8 (argument-digit 8))
(editor-bind-key #\control-9 (argument-digit 9))
(editor-bind-key #\control-meta-0 (argument-digit 0))
(editor-bind-key #\control-meta-1 (argument-digit 1))
(editor-bind-key #\control-meta-2 (argument-digit 2))
(editor-bind-key #\control-meta-3 (argument-digit 3))
(editor-bind-key #\control-meta-4 (argument-digit 4))
(editor-bind-key #\control-meta-5 (argument-digit 5))
(editor-bind-key #\control-meta-6 (argument-digit 6))
(editor-bind-key #\control-meta-7 (argument-digit 7))
(editor-bind-key #\control-meta-8 (argument-digit 8))
(editor-bind-key #\control-meta-9 (argument-digit 9))