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