Re: keystroke names??

[bill@cambridge.apple.com (Bill St. Clair)]

At  8:39 2/25/93 -0500, bright@ENH.NIST.GOV wrote:
>I could use examples on setting comtab keys for specific windows.  You have
>any?

Here's some code that I recently added to the assorted-fred-commands
example file. A window gets *comtab* as it's initial comtab. If you
want to add special commands for that window only, you need to
(setf (slot-value w 'comtab) (copy-comtab (slot-value w 'comtab))) or
create the window with an explicit comtab with e.g.
(make-instance 'fred-window :comtab (copy-comtab *comtab*)).
Then you can comtab-set-key on the window's comtab without
affecting every other window.

---------------------------------------------------------------------

(in-package :ccl)

; Some simple editor mode handling stuff.
(defun ed-enter-mode (w mode-name &rest bindings)
  (let* ((buf (fred-buffer w))
         (modes (buffer-getprop buf :modes))
         (comtab (slot-value w 'comtab)))
    (when (eq comtab *comtab*)
      (setf (slot-value w 'comtab)
            (setq comtab (copy-comtab comtab))))
    (when (assq mode-name modes)
      (ed-exit-mode w mode-name)
      (setq modes (buffer-getprop buf :modes)))
    (let ((old-bindings (insert-key-bindings comtab bindings)))
      (setf (buffer-getprop buf :modes)
            (cons (cons mode-name old-bindings)
                  modes)))))

(defun insert-key-bindings (comtab bindings)
  (let (old-bindings)
    (loop
      (unless bindings (return))
      (let* ((key (pop bindings))
             (function (pop bindings)))
        (push key old-bindings)
        (push (comtab-get-key comtab key) old-bindings)
        (comtab-set-key comtab key function)))
    (nreverse old-bindings)))

(defun ed-exit-mode (w mode-name)
  (let* ((buf (fred-buffer w))
         (modes (buffer-getprop buf :modes))
         (this-mode (assq mode-name modes))
         (comtab (slot-value w 'comtab))
         later-modes)
    (when this-mode
      (loop
        (let ((mode (pop modes)))
          (when (eq mode this-mode)
            (insert-key-bindings comtab (cdr mode))
            (return))
          (push (cons (car mode) (insert-key-bindings comtab (cdr mode)))
                later-modes)))
      (dolist (mode later-modes)
        (push (cons (car mode) (insert-key-bindings comtab (cdr mode)))
              modes))
      (setf (buffer-getprop buf :modes) modes))))

; A mode that makes #\return & #\tab behave as they do in MPW
(defun ed-mpw-mode (w)
  (ed-enter-mode w :mpw
                 #\return 'ed-return-and-indent-for-mpw
                 #\tab 'ed-self-insert
                 '(:meta :shift #\M) 'ed-end-mpw-mode)
  (set-mini-buffer w "MPW mode."))

(defun ed-end-mpw-mode (w)
  (ed-exit-mode w :mpw)
  (set-mini-buffer w "End MPW mode."))

(defconstant *wsp* #.(coerce #(#\space #\tab) 'string))

(defun ed-return-and-indent-for-mpw (w)
  (let* ((buf (fred-buffer w))
         (start (buffer-line-start buf))
         (end (buffer-forward-find-not-char buf *wsp* start buf)))
    (if end
      (decf end)
      (setq end (buffer-position buf)))
    (buffer-insert buf #\return)
    (buffer-insert buf (buffer-substring buf start end))))

(comtab-set-key *comtab* '(:meta :shift #\m) 'ed-mpw-mode)