[Openmcl-cvs-notifications] r13039 - /trunk/source/contrib/foy/list-definitions-cm/history-lists.lisp

[gfoy at clozure.com]

Author: gfoy
Date: Sat Oct 17 18:11:00 2009
New Revision: 13039

Log:
Mod for syntax-styling.

Modified:
    trunk/source/contrib/foy/list-definitions-cm/history-lists.lisp

Modified: trunk/source/contrib/foy/list-definitions-cm/history-lists.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/contrib/foy/list-definitions-cm/history-lists.lisp (origin=
al)
+++ trunk/source/contrib/foy/list-definitions-cm/history-lists.lisp Sat Oct=
 17 18:11:00 2009
@@ -470,14 +470,27 @@
 =

 ;;; ----------------------------------------------------------------------=
------
 ;;; File History Interface:
-;;; =

-(objc:defmethod (#/becomeKeyWindow :void) ((w gui::hemlock-frame))
+;;;
+;;; *** Instead of doing all this stuff need the equivalent of:
+;;; *** (setf ccl::*default-editor-class* 'derived-hemlock-frame-class)
+#-syntax-styling =

+(objc:defMethod (#/becomeKeyWindow :void) ((w gui::hemlock-frame))
   (let* ((path (cmenu:window-path w))
          (name (when (and path (string-equal (pathname-type path) "lisp"))
                  (concatenate 'string (pathname-name path) ".lisp"))))
     (when (and name path)
-      (maybe-add-history-entry *file-history-list* name path))
-    (call-next-method)))
+      (maybe-add-history-entry *file-history-list* name path)))
+  (let ((become-key-function (find-symbol "BECOME-KEY-WINDOW" (find-packag=
e :sax))))
+    (when become-key-function (funcall become-key-function w)))
+  (call-next-method))
+
+#+syntax-styling
+(defMethod become-key-window ((w gui::hemlock-frame))
+  (let* ((path (cmenu:window-path w))
+         (name (when (and path (string-equal (pathname-type path) "lisp"))
+                 (concatenate 'string (pathname-name path) ".lisp"))))
+    (when (and name path)
+      (maybe-add-history-entry *file-history-list* name path))))
 =

 ;;; ----------------------------------------------------------------------=
------
 ;;; Position History Interface: