[climacs-cvs] CVS climacs

[thenriksen]

Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv31984

Modified Files:
	climacs-lisp-syntax-commands.lisp climacs-lisp-syntax.lisp 
Log Message:
The Compile Definition command is not going to work properly in
standalone Drei. Move to Climacs.


--- /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp	2006/11/12 16:06:06	1.1
+++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax-commands.lisp	2006/11/14 12:42:06	1.2
@@ -127,6 +127,12 @@
 Definition command was issued."
   (pop-find-definition-stack))
 
+(define-command (com-compile-definition :name t :command-table pane-lisp-table)
+    ()
+  "Compile and load definition at point."
+  (evaluating-interactively
+    (compile-definition-interactively *current-point* *current-syntax*)))
+
 (esa:set-key 'com-eval-defun
              'climacs-lisp-table
              '((#\x :control :meta)))
@@ -154,3 +160,7 @@
 (esa:set-key  'com-return-from-definition
 	      'climacs-lisp-table
 	      '((#\, :meta)))
+
+(set-key 'com-compile-definition
+         'pane-lisp-table
+         '((#\c :control) (#\c :control)))
--- /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp	2006/11/12 16:06:06	1.1
+++ /project/climacs/cvsroot/climacs/climacs-lisp-syntax.lisp	2006/11/14 12:42:06	1.2
@@ -273,6 +273,27 @@
         (insert-sequence point expansion-string)
         (insert-object point #\Newline)))))
 
+(defun compile-definition-interactively (mark syntax)
+  (let* ((token (definition-at-mark mark syntax))
+         (string (token-string syntax token))
+         (m (clone-mark mark))
+         (buffer-name (name (buffer syntax)))
+         (*read-base* (base syntax)))
+    (with-syntax-package (syntax mark)
+      (forward-definition m syntax)
+      (backward-definition m syntax)
+      (multiple-value-bind (result notes)
+          (compile-form-for-drei (get-usable-image syntax)
+                                 (token-to-object syntax token
+                                                  :read t
+                                                  :package (package-at-mark syntax mark))
+                                 (buffer syntax)
+                                 m)
+        (show-note-counts notes (second result))
+        (when (not (null notes))
+          (show-notes notes buffer-name
+                      (one-line-ify (subseq string 0 (min (length string) 20)))))))))
+
 (defun compile-file-interactively (buffer &optional load-p)
   (cond ((null (filepath buffer))
          (esa:display-message "Buffer ~A is not associated with a file" (name buffer)))