Undo MacIvory keyboard mappings

[Wayne Mesard <bbn.com!mesard@BBN.COM>]

The enclosed code will undo customizations made to the MacIvory keyboard
map.  More specifically, after loading this code, the effect of calls
made to SYS:SET-KEYBOARD-MAPPING from within a LOGIN-FORMS body will be
undone at logout.

A must for any site with >1 person using a MacIvory.

I do some pretty awful remappings, and this code seems to undo them all.
(IOW, I think it works.)

Have fun,

Wayne();

---SNIP-----------------SNIP---
;; Generates a form that undoes the effect of a sys:set-keyboard-mapping call
;; when executed in a LOGIN-FORMS body.

;; No guarantees about the functionality--or apologies for the
;; quality--of this code.  Comments, suggestions, etc. to Mesard@BBN.COM.

(defun undo-keyboard-mapping (value table index &key (shift nil shift-p)
			      (symbol nil symbol-p)
			      all-shifts)
  ;; Rather than IGNOREing VALUE, we should compare it below and only return a
  ;; form if VALUE is different than the current value.
  (declare (ignore value))
  (unless (arrayp table)
    (setq table (sys:find-settable-keyboard-table table)))
  (let ((char-index index)
	(shift-index 0))
    (unless (integerp char-index)
      (multiple-value-setq (char-index shift-index)
	(cli::key-code-for-character table char-index)))
    (if (null char-index)
	;; No mapping currently in effect for char.
	nil		 
	(if all-shifts
	    (let (undo-forms)
	      (dotimes (shift-index 
			(sys:keyboard-table-shift-index-limit table))
		(push `(setf (aref ,table ,shift-index ,char-index)
			     ,(aref table shift-index char-index))
		      undo-forms))
	      (cons 'progn undo-forms))
	    (when shift-p
		  (setf (ldb sys:%%kbd-mapping-table-index-shift shift-index)
				(if shift 1 0)))
	    (when symbol-p
		  (setf (ldb sys:%%kbd-mapping-table-index-symbol shift-index)
				 (if symbol 1 0)))
	    `(setf (aref ,table ,shift-index ,char-index)
		   ,(aref table shift-index char-index))
	    ))
    ))


(defun (:property sys:set-keyboard-table-mapping :undo-function) (form)
  (apply #'undo-keyboard-mapping (cdr form)))