;;; semantic/lex.el --- Lexical Analyzer builder
-;; Copyright (C) 1999-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
(if default
(message
"*Warning* default value of <%s> tokens changed to %S, was %S"
- type default token))
+ type token default))
(setq default token)))
;; Ensure the default matching spec is the first one.
(semantic-lex-type-set type (cons default (nreverse alist))))
(semantic-overlay-put o 'face 'highlight)
o))
-(defsubst semantic-lex-debug-break (token)
- "Break during lexical analysis at TOKEN."
- (when semantic-lex-debug
- (let ((o nil))
- (unwind-protect
- (progn
- (when token
- (setq o (semantic-lex-highlight-token token)))
- (semantic-read-event
- (format "%S :: SPC - continue" token))
- )
- (when o
- (semantic-overlay-delete o))))))
-
;;; Lexical analyzer creation
;;
;; Code for creating a lex function from lists of analyzers.
start position of the block, and STREAM is the list of tokens in that
block.")
-(defvar semantic-lex-reset-hooks nil
+(define-obsolete-variable-alias 'semantic-lex-reset-hooks
+ 'semantic-lex-reset-functions "24.3")
+(defvar semantic-lex-reset-functions nil
"Abnormal hook used by major-modes to reset lexical analyzers.
Hook functions are called with START and END values for the
current lexical pass. Should be set with `add-hook', specifying
;;(defvar semantic-lex-timeout 5
;; "*Number of sections of lexing before giving up.")
+(defsubst semantic-lex-debug-break (token)
+ "Break during lexical analysis at TOKEN."
+ (when semantic-lex-debug
+ (let ((o nil))
+ (unwind-protect
+ (progn
+ (when token
+ (setq o (semantic-lex-highlight-token token)))
+ (semantic-read-event
+ (format "%S :: Depth: %d :: SPC - continue" token semantic-lex-current-depth))
+ )
+ (when o
+ (semantic-overlay-delete o))))))
+
(defmacro define-lex (name doc &rest analyzers)
"Create a new lexical analyzer with NAME.
DOC is a documentation string describing this analyzer.
;; Make sure the state of block parsing starts over.
(setq semantic-lex-block-streams nil)
;; Allow specialty reset items.
- (run-hook-with-args 'semantic-lex-reset-hooks start end)
+ (run-hook-with-args 'semantic-lex-reset-functions start end)
;; Lexing state.
(let* (;(starttime (current-time))
(starting-position (point))
;; Return the token stream
(nreverse semantic-lex-token-stream))))
\f
-;;; Collapsed block tokens delimited by any tokens.
-;;
-(defun semantic-lex-start-block (syntax)
- "Mark the last read token as the beginning of a SYNTAX block."
- (if (or (not semantic-lex-maximum-depth)
- (< semantic-lex-current-depth semantic-lex-maximum-depth))
- (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
- (push (list syntax (car semantic-lex-token-stream))
- semantic-lex-block-stack)))
-
-(defun semantic-lex-end-block (syntax)
- "Process the end of a previously marked SYNTAX block.
-That is, collapse the tokens inside that block, including the
-beginning and end of block tokens, into a high level block token of
-class SYNTAX.
-The token at beginning of block is the one marked by a previous call
-to `semantic-lex-start-block'. The current token is the end of block.
-The collapsed tokens are saved in `semantic-lex-block-streams'."
- (if (null semantic-lex-block-stack)
- (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
- (let* ((stream semantic-lex-token-stream)
- (blk (pop semantic-lex-block-stack))
- (bstream (cdr blk))
- (first (car bstream))
- (last (pop stream)) ;; The current token mark the EOBLK
- tok)
- (if (not (eq (car blk) syntax))
- ;; SYNTAX doesn't match the syntax of the current block in
- ;; the stack. So we encountered the end of the SYNTAX block
- ;; before the end of the current one in the stack which is
- ;; signaled unterminated.
- (semantic-lex-unterminated-syntax-detected (car blk))
- ;; Move tokens found inside the block from the main stream
- ;; into a separate block stream.
- (while (and stream (not (eq (setq tok (pop stream)) first)))
- (push tok bstream))
- ;; The token marked as beginning of block was not encountered.
- ;; This should not happen!
- (or (eq tok first)
- (error "Token %S not found at beginning of block `%s'"
- first syntax))
- ;; Save the block stream for future reuse, to avoid to redo
- ;; the lexical analysis of the block content!
- ;; Anchor the block stream with its start position, so we can
- ;; use: (cdr (assq start semantic-lex-block-streams)) to
- ;; quickly retrieve the lexical stream associated to a block.
- (setcar blk (semantic-lex-token-start first))
- (setcdr blk (nreverse bstream))
- (push blk semantic-lex-block-streams)
- ;; In the main stream, replace the tokens inside the block by
- ;; a high level block token of class SYNTAX.
- (setq semantic-lex-token-stream stream)
- (semantic-lex-push-token
- (semantic-lex-token
- syntax (car blk) (semantic-lex-token-end last)))
- ))))
-\f
;;; Lexical token API
;;
;; Functions for accessing parts of a token. Use these functions
(semantic-lex-token-end semlist)
depth))
\f
+;;; Collapsed block tokens delimited by any tokens.
+;;
+(defun semantic-lex-start-block (syntax)
+ "Mark the last read token as the beginning of a SYNTAX block."
+ (if (or (not semantic-lex-maximum-depth)
+ (< semantic-lex-current-depth semantic-lex-maximum-depth))
+ (setq semantic-lex-current-depth (1+ semantic-lex-current-depth))
+ (push (list syntax (car semantic-lex-token-stream))
+ semantic-lex-block-stack)))
+
+(defun semantic-lex-end-block (syntax)
+ "Process the end of a previously marked SYNTAX block.
+That is, collapse the tokens inside that block, including the
+beginning and end of block tokens, into a high level block token of
+class SYNTAX.
+The token at beginning of block is the one marked by a previous call
+to `semantic-lex-start-block'. The current token is the end of block.
+The collapsed tokens are saved in `semantic-lex-block-streams'."
+ (if (null semantic-lex-block-stack)
+ (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
+ (let* ((stream semantic-lex-token-stream)
+ (blk (pop semantic-lex-block-stack))
+ (bstream (cdr blk))
+ (first (car bstream))
+ (last (pop stream)) ;; The current token mark the EOBLK
+ tok)
+ (if (not (eq (car blk) syntax))
+ ;; SYNTAX doesn't match the syntax of the current block in
+ ;; the stack. So we encountered the end of the SYNTAX block
+ ;; before the end of the current one in the stack which is
+ ;; signaled unterminated.
+ (semantic-lex-unterminated-syntax-detected (car blk))
+ ;; Move tokens found inside the block from the main stream
+ ;; into a separate block stream.
+ (while (and stream (not (eq (setq tok (pop stream)) first)))
+ (push tok bstream))
+ ;; The token marked as beginning of block was not encountered.
+ ;; This should not happen!
+ (or (eq tok first)
+ (error "Token %S not found at beginning of block `%s'"
+ first syntax))
+ ;; Save the block stream for future reuse, to avoid to redo
+ ;; the lexical analysis of the block content!
+ ;; Anchor the block stream with its start position, so we can
+ ;; use: (cdr (assq start semantic-lex-block-streams)) to
+ ;; quickly retrieve the lexical stream associated to a block.
+ (setcar blk (semantic-lex-token-start first))
+ (setcdr blk (nreverse bstream))
+ (push blk semantic-lex-block-streams)
+ ;; In the main stream, replace the tokens inside the block by
+ ;; a high level block token of class SYNTAX.
+ (setq semantic-lex-token-stream stream)
+ (semantic-lex-push-token
+ (semantic-lex-token
+ syntax (car blk) (semantic-lex-token-end last)))
+ ))))
+\f
;;; Analyzer creation macros
;;
;; An individual analyzer is a condition and code that goes with it.
))
))
((setq match (assoc text ',clist))
- (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
- (semantic-lex-push-token
- (semantic-lex-token
- (nth 1 match)
- (match-beginning 0) (match-end 0)))))))
+ (if (> semantic-lex-current-depth 0)
+ (progn
+ (setq semantic-lex-current-depth (1- semantic-lex-current-depth))
+ (semantic-lex-push-token
+ (semantic-lex-token
+ (nth 1 match)
+ (match-beginning 0) (match-end 0)))))))))
)))
\f
;;; Analyzers
(make-variable-buffer-local 'semantic-ignore-comments)
(defvar semantic-flex-enable-newlines nil
- "When flexing, report 'newlines as syntactic elements.
+ "When flexing, report newlines as syntactic elements.
Useful for languages where the newline is a special case terminator.
Only set this on a per mode basis, not globally.")
(make-variable-buffer-local 'semantic-flex-enable-newlines)
(defvar semantic-flex-enable-whitespace nil
- "When flexing, report 'whitespace as syntactic elements.
+ "When flexing, report whitespace as syntactic elements.
Useful for languages where the syntax is whitespace dependent.
Only set this on a per mode basis, not globally.")
(make-variable-buffer-local 'semantic-flex-enable-whitespace)