r11766 - trunk/gwydion/tools/elisp

Author: hannes
Date: Sat Mar 29 07:03:17 2008
New Revision: 11766

Modified:
   trunk/gwydion/tools/elisp/slime-dylan.el
Log:
Job: minor
support for subclass and superclass browser using emacs tree-widget

Modified: trunk/gwydion/tools/elisp/slime-dylan.el
==============================================================================
--- trunk/gwydion/tools/elisp/slime-dylan.el	(original)
+++ trunk/gwydion/tools/elisp/slime-dylan.el	Sat Mar 29 07:03:17 2008
@@ -33,4 +33,71 @@
   (local-set-key (kbd ",") 'slime-dylan-arglist-magic)
   (local-set-key (kbd "(") 'slime-dylan-arglist-magic))

-(provide 'slime-dylan)
\ No newline at end of file
+
+;;; Source modified from slime-xref-browser.el
+;;; slime-xref-browser.el --- xref browsing with tree-widget
+;;
+;; Author: Rui Patrocínio <rui.patrocinio <at> netvisao.pt>
+;; Licencse: GNU GPL (same license as Emacs)
+;; Modified by Hannes Mehnert <hannes <at> opendylan.org>
+
+(defun slime-expand-subclass-node (widget)
+  (or (widget-get widget :args)
+      (let ((name (widget-get widget :tag)))
+	(loop for kid in (slime-eval `(swank:dylan-subclasses ,name))
+	      collect `(tree-widget :tag ,kid
+				    :expander slime-expand-subclass-node
+				    :has-children t)))))
+
+(defun slime-expand-superclass-node (widget)
+  (or (widget-get widget :args)
+      (let ((name (widget-get widget :tag)))
+	(loop for kid in (slime-eval `(swank:dylan-superclasses ,name))
+	      collect `(tree-widget :tag ,kid
+				    :expander slime-expand-superclass-node
+				    :has-children t)))))
+
+(defun slime-dylan-browse-subclasses (name)
+  "Read the name of a class and show its subclasses."
+  (interactive (list (slime-read-symbol-name "Class Name: ")))
+  (slime-call-with-browser-setup 
+   "*slime class browser*" (slime-current-package) "Class Browser"
+   (lambda ()
+     (widget-create 'tree-widget :tag name 
+                    :expander 'slime-expand-subclass-node 
+                    :has-echildren t))))
+
+(defun slime-dylan-browse-superclasses (name)
+  "Read the name of a class and show its superclasses."
+  (interactive (list (slime-read-symbol-name "Class Name: ")))
+  (slime-call-with-browser-setup 
+   "*slime class browser*" (slime-current-package) "Class Browser"
+   (lambda ()
+     (widget-create 'tree-widget :tag name 
+                    :expander 'slime-expand-superclass-node 
+                    :has-echildren t))))
+
+(defvar slime-browser-map nil
+  "Keymap for tree widget browsers")
+
+(require 'tree-widget)
+(unless slime-browser-map
+  (setq slime-browser-map (make-sparse-keymap))
+  (set-keymap-parent slime-browser-map widget-keymap)
+  (define-key slime-browser-map "q" 'bury-buffer))
+
+(defun slime-call-with-browser-setup (buffer package title fn)
+  (switch-to-buffer buffer)
+  (kill-all-local-variables)
+  (setq slime-buffer-package package)
+  (let ((inhibit-read-only t)) (erase-buffer))
+  (widget-insert title "\n\n")
+  (save-excursion
+    (funcall fn))
+  (lisp-mode-variables t)
+  (slime-mode t)
+  (use-local-map slime-browser-map)
+  (widget-setup))
+
+(provide 'slime-dylan)
+
--

-- 
Gd-chatter mailing list
Gd-chatter <at> gwydiondylan.org
https://www.opendylan.org/mailman/listinfo/gd-chatter