[climacs-cvs] CVS update: climacs/gui.lisp climacs/lisp-syntax.lisp climacs/packages.lisp climacs/syntax.lisp

[Robert Strandh]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv21260

Modified Files:
	gui.lisp lisp-syntax.lisp packages.lisp syntax.lisp 
Log Message:
New command `eval-defun' bound to C-M-x

Date: Mon May 30 11:33:39 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.142 climacs/gui.lisp:1.143
--- climacs/gui.lisp:1.142	Mon May 30 09:51:32 2005
+++ climacs/gui.lisp	Mon May 30 11:33:39 2005
@@ -1406,6 +1406,12 @@
 	 (syntax (syntax (buffer pane))))
     (forward-expression point syntax)))
 
+(define-named-command com-eval-defun ()
+  (let* ((pane (current-window))
+	 (point (point pane))
+	 (syntax (syntax (buffer pane))))
+    (eval-defun point syntax)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; Global and dead-escape command tables
@@ -1495,6 +1501,7 @@
 
 (global-set-key '(#\b :control :meta) `(com-backward-expression ,*numeric-argument-marker*))
 (global-set-key '(#\f :control :meta) `(com-forward-expression ,*numeric-argument-marker*))
+(global-set-key '(#\x :control :meta) '(com-eval-defun))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 


Index: climacs/lisp-syntax.lisp
diff -u climacs/lisp-syntax.lisp:1.2 climacs/lisp-syntax.lisp:1.3
--- climacs/lisp-syntax.lisp:1.2	Mon May 30 11:00:35 2005
+++ climacs/lisp-syntax.lisp	Mon May 30 11:33:39 2005
@@ -415,14 +415,14 @@
 
 (define-parser-state |form* | (lexer-toplevel-state parser-state) ())
 (define-parser-state form-may-follow (lexer-toplevel-state parser-state) ())
-(define-parser-state initial-state (form-may-follow) ())
+(define-parser-state |initial-state | (form-may-follow) ())
 
-(define-new-lisp-state (initial-state form) initial-state)
+(define-new-lisp-state (|initial-state | form) |initial-state |)
 
-(define-lisp-action (initial-state (eql nil))
+(define-lisp-action (|initial-state | (eql nil))
   (make-instance 'form* :children (pop-all syntax)))
 
-(define-new-lisp-state (initial-state form*) |form* | )
+(define-new-lisp-state (|initial-state | form*) |form* | )
   
 (define-lisp-action (|form* | (eql nil))
   (throw 'done nil))
@@ -742,7 +742,7 @@
 	   (setf stack-top (find-last-valid-lexeme stack-top (offset low-mark)))
 	   (setf (offset scan) (if (null stack-top) 0 (end-offset stack-top))
 		 current-state (if (null stack-top)
-				   initial-state
+				   |initial-state |
 				   (new-state syntax
 					      (parser-state stack-top)
 					      stack-top)))
@@ -958,3 +958,14 @@
     (if potential-form
 	(setf (offset mark) (end-offset potential-form))
 	(error 'no-expression))))
+
+(defmethod eval-defun (mark (syntax lisp-syntax))
+  (with-slots (stack-top) syntax
+     (loop for form in (children stack-top)
+	   when (and (mark<= (start-offset form) mark)
+		     (mark<= mark (end-offset form)))
+	     do (return (eval (read-from-string 
+			       (coerce (buffer-sequence (buffer syntax)
+							(start-offset form)
+							(end-offset form))
+				       'string)))))))
\ No newline at end of file


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.63 climacs/packages.lisp:1.64
--- climacs/packages.lisp:1.63	Mon May 30 09:25:13 2005
+++ climacs/packages.lisp	Mon May 30 11:33:39 2005
@@ -106,6 +106,7 @@
 	   #:no-such-operation #:no-expression
            #:syntax-line-indentation
 	   #:forward-expression #:backward-expression
+	   #:eval-defun
 	   #:redisplay-pane-with-syntax
 	   #:beginning-of-paragraph #:end-of-paragraph))
 


Index: climacs/syntax.lisp
diff -u climacs/syntax.lisp:1.51 climacs/syntax.lisp:1.52
--- climacs/syntax.lisp:1.51	Mon May 30 09:25:13 2005
+++ climacs/syntax.lisp	Mon May 30 11:33:39 2005
@@ -28,6 +28,7 @@
 (define-condition no-such-operation (simple-error)
   ()
   (:report (lambda (condition stream)
+	     (declare (ignore condition))
 	     (format stream "Operation unavailable for this syntax")))
   (:documentation "This condition is signaled whenever an attempt is
 made to execute an operation that is unavailable for the particular syntax" ))
@@ -35,6 +36,7 @@
 (define-condition no-expression (simple-error)
   ()
   (:report (lambda (condition stream)
+	     (declare (ignore condition))
 	     (format stream "No expression at point")))
   (:documentation "This condition is signaled whenever an attempt is
 made to execute a by-experssion motion command and no expression is available." ))
@@ -51,6 +53,8 @@
 
 (defgeneric backward-expression (mark syntax))
 
+(defgeneric eval-defun (mark syntax))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Syntax completion
@@ -147,6 +151,9 @@
   (error 'no-such-operation))
 
 (defmethod backward-expression (mark syntax)
+  (error 'no-such-operation))
+
+(defmethod eval-defun (mark syntax)
   (error 'no-such-operation))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;