Update of /project/climacs/cvsroot/climacs In directory clnet:/tmp/cvs-serv15857

Modified Files: lisp-syntax.lisp Log Message: Made `lex-token' able to discern between numbers and symbols. Also made `package-of' read the package defined in the local options line if no (in-package) forms can be found.

--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/04/23 12:11:26 1.52 +++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/04/23 14:38:57 1.53 @@ -380,7 +380,7 @@ (#| (fo) (make-instance 'multiple-escape-start-lexeme)) (t (cond ((or (constituentp object) (eql object #\)) - (lex-token scan)) + (lex-token syntax scan)) (t (fo) (make-instance 'error-lexeme))))))))

(defmethod lex ((syntax lisp-syntax) (state lexer-list-state) scan) @@ -446,25 +446,54 @@ (make-instance 'word-lexeme)) (t (fo) (make-instance 'delimiter-lexeme)))))

-(defun lex-token (scan) - (macrolet ((fo () `(forward-object scan))) - (tagbody - start - (when (end-of-buffer-p scan) - (return-from lex-token (make-instance 'complete-token-lexeme))) - (when (constituentp (object-after scan)) - (fo) - (go start)) - (when (eql (object-after scan) #\) - (fo) - (when (end-of-buffer-p scan) - (return-from lex-token (make-instance 'incomplete-lexeme))) - (fo) - (go start)) - (when (eql (object-after scan) #|) - (fo) - (return-from lex-token (make-instance 'multiple-escape-start-lexeme))) - (return-from lex-token (make-instance 'complete-token-lexeme))))) +(defun lex-token (syntax scan) + ;; May need more work. Can recognize symbols and numbers. + (flet ((fo () (forward-object scan))) + (let ((could-be-number t) + sign-seen dot-seen slash-seen) + (flet ((return-token-or-number-lexeme () + (return-from lex-token + (if could-be-number + (make-instance 'number-lexeme) + (make-instance 'complete-token-lexeme)))) + (this-object () + (object-after scan))) + (tagbody + START + (when (end-of-buffer-p scan) + (return-token-or-number-lexeme)) + (when (constituentp (object-after scan)) + (cond ((or (eql (this-object) #+) + (eql (this-object) #-)) + (when sign-seen + (setf could-be-number nil)) + (setf sign-seen t)) + ((eql (this-object) #.) + (when dot-seen + (setf could-be-number nil)) + (setf dot-seen t)) + ((eql (this-object) #/) + (when slash-seen + (setf could-be-number nil)) + (setf slash-seen t)) + ;; We obey the base specified in the file when + ;; determining whether or not this character is an + ;; integer. + ((not (digit-char-p (this-object) + (base syntax))) + (setf could-be-number nil))) + (fo) + (go START)) + (when (eql (object-after scan) #\) + (fo) + (when (end-of-buffer-p scan) + (return-from lex-token (make-instance 'incomplete-lexeme))) + (fo) + (go START)) + (when (eql (object-after scan) #|) + (fo) + (return-from lex-token (make-instance 'multiple-escape-start-lexeme))) + (return-token-or-number-lexeme))))))

(defmethod lex ((syntax lisp-syntax) (state lexer-escaped-token-state) scan) (let ((bars-seen 0)) @@ -1106,40 +1135,41 @@ 'cl:in-package)))))) (with-slots (stack-top) syntax (let ((form (find-if #'test (children stack-top)))) - (when form - (let ((package-form (second-form (children form)))) - (when package-form - (let ((package-name - (typecase package-form - (token-mixin - (coerce (buffer-sequence - buffer - (start-offset package-form) - (end-offset package-form)) - 'string)) - (complete-string-form - (coerce (buffer-sequence - buffer - (1+ (start-offset package-form)) - (1- (end-offset package-form))) - 'string)) - (quote-form - (coerce (buffer-sequence - buffer - (start-offset (second-noncomment (children package-form))) - (end-offset (second-noncomment (children package-form)))) - 'string)) - (uninterned-symbol-form - (coerce (buffer-sequence - buffer - (start-offset (second-noncomment (children package-form))) - (end-offset (second-noncomment (children package-form)))) - 'string)) - (t 'nil)))) - (when package-name - (let ((package-symbol (parse-token package-name))) - (or (find-package package-symbol) - package-symbol)))))))))))) + (or (when form + (let ((package-form (second-form (children form)))) + (when package-form + (let ((package-name + (typecase package-form + (token-mixin + (coerce (buffer-sequence + buffer + (start-offset package-form) + (end-offset package-form)) + 'string)) + (complete-string-form + (coerce (buffer-sequence + buffer + (1+ (start-offset package-form)) + (1- (end-offset package-form))) + 'string)) + (quote-form + (coerce (buffer-sequence + buffer + (start-offset (second-noncomment (children package-form))) + (end-offset (second-noncomment (children package-form)))) + 'string)) + (uninterned-symbol-form + (coerce (buffer-sequence + buffer + (start-offset (second-noncomment (children package-form))) + (end-offset (second-noncomment (children package-form)))) + 'string)) + (t 'nil)))) + (when package-name + (let ((package-symbol (parse-token package-name))) + (or (find-package package-symbol) + package-symbol))))))) + (option-specified-package syntax)))))))

(defmethod update-syntax (buffer (syntax lisp-syntax)) (let* ((low-mark (low-mark buffer))