Changeset 6702

Timestamp:

Jun 12, 2007, 12:42:36 PM (17 years ago)

Author:

Gary Byers

Message:

New self-insert; echo-area stuff.

File:

• branches/ide-1.0/ccl/hemlock/src/interp.lisp (modified) (2 diffs)

branches/ide-1.0/ccl/hemlock/src/interp.lisp

@@ -423 +423 @@
 
 
+(defvar *self-insert-command* nil)
+
+(defun self-insert-command ()
+  (or *self-insert-command*
+      (setq *self-insert-command* (getstring "Self Insert" *command-names*))))
+
     
 ;;; %COMMAND-LOOP  --  Internal
@@ -450 +456 @@
         (let* ((temporary-object-pool (allocate-temporary-object-pool)))
           (unwind-protect
-               (progn
-                 (unless (eq *current-buffer* *echo-area-buffer*)
-                   (unless (or (zerop (length cmd))
-                               (not (value hemlock::key-echo-delay)))
-                     (editor-sleep (value hemlock::key-echo-delay))
-                     (unless (listen-editor-input *editor-input*)
-                       (clear-echo-area)
-                       (dotimes (i (length cmd))
-                         (hemlock-ext:print-pretty-key (aref cmd i) *echo-area-stream*)
-                         (write-char #\space *echo-area-stream*)))))
-                 (vector-push-extend (get-key-event *editor-input*) cmd)
-                 (multiple-value-bind (trans-result prefix-p)
-                     (translate-key cmd trans)
-                   (multiple-value-bind (res t-bindings)
-                       (get-current-binding trans-result)
-                     (etypecase res
-                       (command 
-                        (let ((punt t))
-                          (unless (eq *current-buffer* *echo-area-buffer*)
-                            (clear-echo-area))
-                          (catch 'command-loop-catcher
-                            (let* ((doc (buffer-document *current-buffer*)))
-                              (unwind-protect
-                                   (progn
-                                     (when doc (hi::document-begin-editing doc))
-                                     (dolist (c t-bindings)
-                                       (funcall *invoke-hook* c *prefix-argument*))
-                                     (funcall *invoke-hook* res *prefix-argument*)
-                                     (setf punt nil))
-                                (when doc (hi::document-end-editing doc)))))
-                          (when punt (invoke-hook hemlock::command-abort-hook)))
-                        (if *command-type-set*
-                          (setq *command-type-set* nil)
-                          (setq *last-command-type* nil))
-                        (if *prefix-argument-supplied*
-                          (setq *prefix-argument-supplied* nil)
-                          (setq *prefix-argument* nil))
-                        (setf (fill-pointer cmd) 0))
-                       (null
-                        (unless prefix-p
-                          (beep)
-                          (setq *prefix-argument* nil)
-                          (setf (fill-pointer cmd) 0)))
-                       (hash-table)))))
-            (free-temporary-objects temporary-object-pool)))))))
+               (multiple-value-bind (key self-insert)
+                   (get-key-event *editor-input*)
+                 (progn
+                   (unless (eq *current-buffer* *echo-area-buffer*)
+                     (when (buffer-modified *echo-area-buffer*)
+                       (clear-echo-area))
+                     (unless (or (zerop (length cmd))
+                                 (not (value hemlock::key-echo-delay)))
+                       (editor-sleep (value hemlock::key-echo-delay))
+                       (unless (listen-editor-input *editor-input*)
+                         (clear-echo-area)
+                         (dotimes (i (length cmd))
+                           (hemlock-ext:print-pretty-key (aref cmd i) *echo-area-stream*)
+                           (write-char #\space *echo-area-stream*)))))
+                   (vector-push-extend key cmd)
+                   (multiple-value-bind (trans-result prefix-p)
+                       (unless self-insert (translate-key cmd trans))
+                     (multiple-value-bind (res t-bindings)
+                         (if self-insert
+                           (self-insert-command)
+                           (get-current-binding trans-result))
+                       (etypecase res
+                         (command 
+                          (let ((punt t))
+                            (catch 'command-loop-catcher
+                              (let* ((doc (buffer-document *current-buffer*)))
+                                (unwind-protect
+                                     (progn
+                                       (when doc (hi::document-begin-editing doc))
+                                       (dolist (c t-bindings)
+                                         (funcall *invoke-hook* c *prefix-argument*))
+                                       (funcall *invoke-hook* res *prefix-argument*)
+                                       (setf punt nil))
+                                  (when doc (hi::document-end-editing doc)))))
+                            (when punt (invoke-hook hemlock::command-abort-hook)))
+                          (if *command-type-set*
+                            (setq *command-type-set* nil)
+                            (setq *last-command-type* nil))
+                          (if *prefix-argument-supplied*
+                            (setq *prefix-argument-supplied* nil)
+                            (setq *prefix-argument* nil))
+                          (setf (fill-pointer cmd) 0))
+                         (null
+                          (unless prefix-p
+                            (beep)
+                            (setq *prefix-argument* nil)
+                            (setf (fill-pointer cmd) 0)))
+                         (hash-table)))))
+                 (free-temporary-objects temporary-object-pool))))))))