[clim-desktop-cvs] CVS clim-desktop

[thenriksen]

Update of /project/clim-desktop/cvsroot/clim-desktop
In directory clnet:/tmp/cvs-serv6237

Modified Files:
	swine.lisp 
Log Message:
Cleaned stuff up, removed unused functions, moved some functions to
Climacs proper.


--- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp	2006/04/30 12:10:05	1.4
+++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp	2006/05/02 14:40:15	1.5
@@ -27,11 +27,6 @@
 
 ;; Convenience functions:
 
-(defun buffer-substring (buffer start end)
-  "Return a string of the contents of buffer from `start' to
-`end'."
-  (coerce (buffer-sequence buffer start end) 'string))
-
 (defun unlisted (obj)
   (if (listp obj)
       (first obj)
@@ -42,81 +37,29 @@
       obj
       (list obj)))
 
-(defun definition-at-mark (mark syntax)
+(defun text-of-definition-at-mark (mark syntax)
   "Return the text of the definition at mark."
-  (let* ((definition (form-toplevel (or (form-around syntax (offset mark))
-                                        (form-after syntax (offset mark)))
-                                    syntax))
-         (definition-pos (start-offset definition)))
+  (let ((definition (definition-at-mark mark syntax)))
     (buffer-substring (buffer mark)
-                      definition-pos
+                      (start-offset definition)                      
                       (end-offset definition))))
                       
-(defun expression-at-mark (mark syntax)
- "Return the text of the expression at mark."
- (let ((m (clone-mark mark)))
-   (forward-expression m syntax)
-   (let ((end (offset m)))
-     (backward-expression m syntax)
-     (buffer-substring (buffer mark) (offset m) end))))
+(defun text-of-expression-at-mark (mark syntax)
+  "Return the text of the expression at mark."
+  (let ((expression (expression-at-mark mark syntax)))
+    (buffer-substring (buffer mark)
+                      (start-offset expression)                      
+                      (end-offset expression))))
 
 (defun symbol-name-at-mark (mark syntax)
- "Return the text of the symbol at mark."
- (let ((potential-form (or (form-around syntax (offset mark))
-			   (form-around syntax (1- (offset mark)))
-			   (form-around syntax (1+ (offset mark))))))
-   (when (and potential-form
-              (typep potential-form 'token-mixin))
-     (buffer-substring (buffer mark) (start-offset potential-form)
-                       (end-offset potential-form)))))
-
-(defun find-operator-in-trees (trees list offset)
- (cond ((or (null trees)
-            (>= (start-offset (first-form trees)) offset))
-        list)
-       ((or (< (start-offset (first-form trees)) offset (end-offset (first-form trees)))
-            (typep (first-form trees) 'incomplete-form-mixin))
-        (cons (first-form trees)
-              (find-operator-in-tree (first-form trees) offset)))
-       (t (find-operator-in-trees (rest-forms trees) list offset))))
-
-(defun find-operator-in-tree (tree offset)
- (if (null (children tree))
-     '()
-     (find-operator-in-trees (children tree) nil offset)))
-
-(defun enclosing-operator-names-at-mark (mark syntax)
- "Returns a list of strings being the operator names surrounding mark."
- (with-slots (stack-top) syntax
-    (loop for form in (find-operator-in-tree stack-top (offset mark))
-          for token = (and form (second-form (children form)))
-          when (and (typep form 'list-form)
-                    (typep token 'token-mixin))
-            collect (buffer-substring (buffer mark)
-                                      (start-offset token)
-                                      (end-offset token)))))
-
-;; Once Dwight understands the syntax facilities better,
-;; he should rewrite this to something like the above.
-
-(defmethod backward-up-list-no-error (mark (syntax lisp-syntax))
-  (let ((form (or (form-around syntax (offset mark))
-		  (form-before syntax (offset mark))
-		  (form-after syntax (offset mark)))))
-    (when form
-	(let ((parent (parent form)))
-	  (if (typep parent 'list-form)
-	      (setf (offset mark) (start-offset parent)))))))
-
-(defun enclosing-list-first-word (mark syntax) 
- "Return the text of the expression at mark. Mark need not be in
-a complete list form."
- ;; This is not very fast, but fast enough.
- (first (reverse (enclosing-operator-names-at-mark mark syntax))))
+  "Return the text of the symbol at mark."
+  (symbol-name (token-to-symbol syntax
+                                (expression-at-mark mark syntax)
+                                :preserve)))
 
 (defun macroexpand-with-swank (mark syntax &optional (all nil))
  (with-slots (package) syntax
-    (let* ((string (expression-at-mark mark syntax))
+    (let* ((string (text-of-expression-at-mark mark syntax))
            (swank::*buffer-package* (or package *package*))
            (swank::*buffer-readtable* *readtable*)
            (expansion (if all
@@ -159,7 +102,7 @@
 
 (defun compile-defun-with-swank (mark pane syntax)
  (with-slots (package) syntax
-    (let* ((string (definition-at-mark mark syntax))
+    (let* ((string (text-of-definition-at-mark mark syntax))
            (buffer-name (name (buffer pane)))
            (buffer-file-name (filepath (buffer pane)))
            (m (clone-mark mark))
@@ -845,7 +788,8 @@
                             indexing-start-arg
                             operator-form))
          (preceding-arg-obj (when preceding-arg-token
-                              (token-to-object syntax preceding-arg-token t))))
+                              (token-to-object syntax preceding-arg-token
+                                               :no-error t))))
     (values preceding-arg-obj argument-indices)))
 
  ;; This is a generic function in order to facilitate different lambda