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
