Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv24499
Modified Files: lisp-syntax.lisp Log Message: Added new `form-operator' utility function, added some minor performance improvements and made the paren-matcher highlight both matching parens.
--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/03/01 19:32:07 1.46 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/04/03 20:51:51 1.47 @@ -1252,7 +1252,7 @@
(defmethod display-parse-tree (parse-symbol syntax pane) (loop for child in (children parse-symbol) - do (display-parse-tree child syntax pane))) + do (display-parse-tree child syntax pane)))
(defmethod display-parse-tree ((parse-symbol error-symbol) (syntax lisp-syntax) pane) (let ((children (children parse-symbol))) @@ -1282,7 +1282,7 @@ (or (symbolp object) (stringp object)))
(defmethod display-parse-tree ((parse-symbol token-mixin) (syntax lisp-syntax) pane) - (if (> (end-offset parse-symbol) (start-offset parse-symbol)) + (if (> (the fixnum (end-offset parse-symbol)) (the fixnum (start-offset parse-symbol))) (let ((string (coerce (buffer-sequence (buffer syntax) (start-offset parse-symbol) (end-offset parse-symbol)) @@ -1431,13 +1431,22 @@ #'eval-fc conditionals))))))))) (defmethod display-parse-tree ((parse-symbol complete-list-form) (syntax lisp-syntax) pane) - (let ((children (children parse-symbol))) - (if (= (end-offset parse-symbol) (offset (point pane))) + (let* ((children (children parse-symbol)) + (point-offset (the fixnum (offset (point pane)))) + ;; The following is set to true if the location if the point + ;; warrants highlighting of a set of matching parantheses. + (should-highlight (or (= (the fixnum (end-offset parse-symbol)) point-offset) + (= (the fixnum (start-offset parse-symbol)) point-offset)))) + (if should-highlight (with-text-face (pane :bold) (display-parse-tree (car children) syntax pane)) (display-parse-tree (car children) syntax pane)) - (loop for child in (cdr children) - do (display-parse-tree child syntax pane)))) + (loop for child-list on (cdr children) + if (and should-highlight (null (cdr child-list))) do + (with-text-face (pane :bold) + (display-parse-tree (car child-list) syntax pane)) + else do + (display-parse-tree (car child-list) syntax pane))))
(defmethod redisplay-pane-with-syntax ((pane climacs-pane) (syntax lisp-syntax) current-p) (with-slots (top bot) pane @@ -1447,7 +1456,7 @@ (setf *white-space-start* (offset top))) (let ((*current-faces* *standard-faces*)) (with-slots (stack-top) syntax - (display-parse-tree stack-top syntax pane))) + (display-parse-tree stack-top syntax pane))) (when (mark-visible-p pane) (display-mark pane syntax)) (display-cursor pane syntax current-p))
@@ -1665,6 +1674,17 @@ (defun in-comment-p (mark syntax) (in-type-p mark syntax 'comment))
+(defgeneric form-operator (form syntax) + (:documentation "Return the operator of `form' as a +symbol. Returns nil if none can be found.") + (:method (form syntax) nil)) + +(defmethod form-operator ((form list-form) syntax) + (let* ((operator-token (first-form (rest (children form)))) + (operator-symbol (when operator-token + (token-to-symbol syntax operator-token)))) + operator-symbol)) + ;;; shamelessly replacing SWANK code ;; We first work through the string removing the characters and noting ;; which ones are escaped. We then replace each character with the