[clim-desktop-cvs] CVS clim-desktop
thenriksen
thenriksen at common-lisp.net
Sun May 28 16:28:42 UTC 2006
Update of /project/clim-desktop/cvsroot/clim-desktop
In directory clnet:/tmp/cvs-serv25693
Modified Files:
swine.lisp
Log Message:
Added code to handle the case where `current-arg-indices' is NIL.
--- /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/28 13:37:46 1.11
+++ /project/clim-desktop/cvsroot/clim-desktop/swine.lisp 2006/05/28 16:28:42 1.12
@@ -479,54 +479,56 @@
&optional (split-arglist (split-arglist-on-keywords arglist)))
"Find the simple arguments of `arglist' that would be affected
if an argument was intered at index `current-arg-index' in the
- arglist. `Preceding-arg-key' should either be nil or the
- argument directly preceding point. `Split-arglist' should
- either be a split arglist or nil, in which case `split-arglist'
- will be computed from `arglist'. This function returns two
- values: The primary value is a list of symbols that should be
- emphasized, the secondary value is a list of symbols that
- should be highlighted."
- (flet ((get-args (keyword)
- (rest (assoc keyword split-arglist))))
- (let ((mandatory-argument-count (length (get-args '&mandatory))))
- (cond ((> mandatory-argument-count
- current-arg-index)
- ;; We are in the main, mandatory, positional arguments.
- (let ((relevant-arg (elt (get-args '&mandatory)
- current-arg-index)))
- ;; We do not handle complex argument lists here, only
- ;; pure standard arguments.
- (unless (and (listp relevant-arg)
- (< current-arg-index mandatory-argument-count))
- (values nil (list (unlisted relevant-arg))))))
- ((> (+ (length (get-args '&optional))
- (length (get-args '&mandatory)))
- current-arg-index)
- ;; We are in the &optional arguments.
- (values nil
- (list (unlisted (elt (get-args '&optional)
- (- current-arg-index
- (length (get-args '&mandatory))))))))
- (t
- (let ((body-or-rest-args (or (get-args '&rest)
- (get-args '&body)))
- (key-arg (find (format nil "~A" preceding-arg)
- (get-args '&key)
- :test #'string=
- :key #'(lambda (arg)
- (symbol-name (unlisted arg))))))
- ;; We are in the &body, &rest or &key arguments.
- (values
- ;; Only emphasize the &key
- ;; symbol if we are in a position to add a new
- ;; keyword-value pair, and not just in a position to
- ;; specify a value for a keyword.
- (when (and (null key-arg)
- (get-args '&key))
- '(&key))
- (append (when key-arg
- (list (unlisted key-arg)))
- body-or-rest-args))))))))
+ arglist. If `current-arg-index' is nil, no calculation will be
+ done (this function will just return nil). `Preceding-arg'
+ should either be nil or the argument directly preceding
+ point. `Split-arglist' should either be a split arglist or nil,
+ in which case `split-arglist' will be computed from
+ `arglist'. This function returns two values: The primary value
+ is a list of symbols that should be emphasized, the secondary
+ value is a list of symbols that should be highlighted."
+ (when current-arg-index
+ (flet ((get-args (keyword)
+ (rest (assoc keyword split-arglist))))
+ (let ((mandatory-argument-count (length (get-args '&mandatory))))
+ (cond ((> mandatory-argument-count
+ current-arg-index)
+ ;; We are in the main, mandatory, positional arguments.
+ (let ((relevant-arg (elt (get-args '&mandatory)
+ current-arg-index)))
+ ;; We do not handle complex argument lists here, only
+ ;; pure standard arguments.
+ (unless (and (listp relevant-arg)
+ (< current-arg-index mandatory-argument-count))
+ (values nil (list (unlisted relevant-arg))))))
+ ((> (+ (length (get-args '&optional))
+ (length (get-args '&mandatory)))
+ current-arg-index)
+ ;; We are in the &optional arguments.
+ (values nil
+ (list (unlisted (elt (get-args '&optional)
+ (- current-arg-index
+ (length (get-args '&mandatory))))))))
+ (t
+ (let ((body-or-rest-args (or (get-args '&rest)
+ (get-args '&body)))
+ (key-arg (find (format nil "~A" preceding-arg)
+ (get-args '&key)
+ :test #'string=
+ :key #'(lambda (arg)
+ (symbol-name (unlisted arg))))))
+ ;; We are in the &body, &rest or &key arguments.
+ (values
+ ;; Only emphasize the &key
+ ;; symbol if we are in a position to add a new
+ ;; keyword-value pair, and not just in a position to
+ ;; specify a value for a keyword.
+ (when (and (null key-arg)
+ (get-args '&key))
+ '(&key))
+ (append (when key-arg
+ (list (unlisted key-arg)))
+ body-or-rest-args)))))))))
(defun analyze-arglist-impl (arglist current-arg-indices preceding-arg provided-args)
"The implementation for `analyze-arglist'."
@@ -537,7 +539,9 @@
split-arglist))
(mandatory-argument-count
(length (rest (assoc '&mandatory split-arglist))))
- (current-arg-index (or (first current-arg-indices) 0))
+
+ (current-arg-index (or (first current-arg-indices)
+ 0))
ret-arglist
emphasized-symbols
highlighted-symbols)
@@ -546,18 +550,23 @@
;; arguments will be handled specially.
(multiple-value-bind (es hs)
(find-affected-simple-arguments arglist
- current-arg-index
+ ;; if `current-arg-indices' is
+ ;; nil, that means that we do
+ ;; not have enough information
+ ;; to properly highlight
+ ;; symbols in the arglist.
+ (and current-arg-indices
+ current-arg-index)
preceding-arg
split-arglist)
(setf emphasized-symbols es)
(setf highlighted-symbols hs))
- ;; We loop over the arglist and build a new list, and if we
- ;; have a default value for a given argument, we insert it into
- ;; the list. Also, whenever we encounter a list in a mandatory
- ;; argument position, we assume that it is a destructuring
- ;; arglist and recursively calls `analyze-arglist' on it
- ;; to find the arglist and emphasized and highlighted symbols for
- ;; it.
+ ;; We loop over the arglist and build a new list, and if we have a
+ ;; default value for a given argument, we insert it into the
+ ;; list. Also, whenever we encounter a list in a mandatory
+ ;; argument position, we assume that it is a destructuring arglist
+ ;; and recursively calls `analyze-arglist' on it to find the
+ ;; arglist and emphasized and highlighted symbols for it.
(labels ((generate-arglist (arglist)
(loop
for arg-element in arglist
@@ -589,10 +598,16 @@
preceding-arg
(when (< index (length provided-args))
(listed (elt provided-args index))))
- ;; Unless our `current-arg-index' actually
- ;; refers to this sublist, its highlighted
- ;; and emphasized symbols are ignored.
- (if (= index current-arg-index)
+ ;; Unless our `current-arg-index'
+ ;; actually refers to this sublist, its
+ ;; highlighted and emphasized symbols
+ ;; are ignored. Also, if
+ ;; `current-arg-indices' is nil, that
+ ;; means that we do not have enough
+ ;; information to properly highlight
+ ;; symbols in the arglist.
+ (when (and current-arg-indices
+ (= index current-arg-index))
(if (and (rest current-arg-indices))
(setf emphasized-symbols
(union (mapcar #'unlisted
More information about the Clim-desktop-cvs
mailing list