;;; lex-spp.el --- Semantic Lexical Pre-processor
-;;; Copyright (C) 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <zappo@gnu.org>
;; NN_END
;;
+(require 'semantic)
(require 'semantic/lex)
;;; Code:
(make-variable-buffer-local 'semantic-lex-spp-dynamic-macro-symbol-obarray)
(defvar semantic-lex-spp-dynamic-macro-symbol-obarray-stack nil
- "A stack of obarrays for temporarilly scoped macro values.")
+ "A stack of obarrays for temporarily scoped macro values.")
(make-variable-buffer-local 'semantic-lex-spp-dynamic-macro-symbol-obarray-stack)
(defvar semantic-lex-spp-expanded-macro-stack nil
;;
(defsubst semantic-lex-spp-symbol (name)
"Return spp symbol with NAME or nil if not found.
-The searcy priority is:
+The search priority is:
1. DYNAMIC symbols
2. PROJECT specified symbols.
3. SYSTEM specified symbols."
(setq semantic-lex-spp-dynamic-macro-symbol-obarray-stack
(make-vector 13 0))))
+(defun semantic-lex-spp-value-valid-p (value)
+ "Return non-nil if VALUE is valid."
+ (or (null value)
+ (stringp value)
+ (and (consp value)
+ (or (semantic-lex-token-p (car value))
+ (eq (car (car value)) 'spp-arg-list)))))
+
+(defvar semantic-lex-spp-debug-symbol nil
+ "A symbol to break on if it is being set somewhere.")
+
+(defun semantic-lex-spp-enable-debug-symbol (sym)
+ "Enable debugging for symbol SYM.
+Disable debugging by entering nothing."
+ (interactive "sSymbol: ")
+ (if (string= sym "")
+ (setq semantic-lex-spp-debug-symbol nil)
+ (setq semantic-lex-spp-debug-symbol sym)))
+
+(defmacro semantic-lex-spp-validate-value (name value)
+ "Validate the NAME and VALUE of a macro before it is set."
+; `(progn
+; (when (not (semantic-lex-spp-value-valid-p ,value))
+; (error "Symbol \"%s\" with bogus value %S" ,name ,value))
+; (when (and semantic-lex-spp-debug-symbol
+; (string= semantic-lex-spp-debug-symbol name))
+; (debug))
+; )
+ nil
+ )
+
(defun semantic-lex-spp-symbol-set (name value &optional obarray-in)
"Set value of spp symbol with NAME to VALUE and return VALUE.
If optional OBARRAY-IN is non-nil, then use that obarray instead of
the dynamic map."
+ (semantic-lex-spp-validate-value name value)
(if (and (stringp value) (string= value "")) (setq value nil))
(set (intern name (or obarray-in
(semantic-lex-spp-dynamic-map)))
(defun semantic-lex-spp-symbol-push (name value)
"Push macro NAME with VALUE into the map.
Reverse with `semantic-lex-spp-symbol-pop'."
+ (semantic-lex-spp-validate-value name value)
(let* ((map (semantic-lex-spp-dynamic-map))
(stack (semantic-lex-spp-dynamic-map-stack))
(mapsym (intern name map))
;; Argument lists are saved as a lexical token at the beginning
;; of a replacement value.
-(defun semantic-lex-spp-one-token-to-txt (tok)
+(defun semantic-lex-spp-one-token-to-txt (tok &optional blocktok)
"Convert the token TOK into a string.
If TOK is made of multiple tokens, convert those to text. This
conversion is needed if a macro has a merge symbol in it that
combines the text of two previously distinct symbols. For
-exampe, in c:
+example, in c:
-#define (a,b) a ## b;"
+#define (a,b) a ## b;
+
+If optional string BLOCKTOK matches the expanded value, then do not
+continue processing recursively."
(let ((txt (semantic-lex-token-text tok))
(sym nil)
)
- (cond ((and (eq (car tok) 'symbol)
- (setq sym (semantic-lex-spp-symbol txt))
- (not (semantic-lex-spp-macro-with-args (symbol-value sym)))
- )
- ;; Now that we have a symbol,
- (let ((val (symbol-value sym)))
- (cond ((and (consp val)
- (symbolp (car val)))
- (semantic-lex-spp-one-token-to-txt val))
- ((and (consp val)
- (consp (car val))
- (symbolp (car (car val))))
- (mapconcat (lambda (subtok)
- (semantic-lex-spp-one-token-to-txt subtok))
- val
- ""))
- ;; If val is nil, that's probably wrong.
- ;; Found a system header case where this was true.
- ((null val) "")
- ;; Debug wierd stuff.
- (t (debug)))
- ))
- ((stringp txt)
- txt)
- (t nil))
+ (cond
+ ;; Recursion prevention
+ ((and (stringp blocktok) (string= txt blocktok))
+ blocktok)
+ ;; A complex symbol
+ ((and (eq (car tok) 'symbol)
+ (setq sym (semantic-lex-spp-symbol txt))
+ (not (semantic-lex-spp-macro-with-args (symbol-value sym)))
+ )
+ ;; Now that we have a symbol,
+ (let ((val (symbol-value sym)))
+ (cond
+ ;; This is another lexical token.
+ ((and (consp val)
+ (symbolp (car val)))
+ (semantic-lex-spp-one-token-to-txt val txt))
+ ;; This is a list of tokens.
+ ((and (consp val)
+ (consp (car val))
+ (symbolp (car (car val))))
+ (mapconcat (lambda (subtok)
+ (semantic-lex-spp-one-token-to-txt subtok))
+ val
+ ""))
+ ;; If val is nil, that's probably wrong.
+ ;; Found a system header case where this was true.
+ ((null val) "")
+ ;; Debug wierd stuff.
+ (t (debug)))
+ ))
+ ((stringp txt)
+ txt)
+ (t nil))
))
(defun semantic-lex-spp-macro-with-args (val)
(goto-char end)
(setq arg-parsed
(semantic-lex-spp-one-token-and-move-for-macro
- (point-at-eol)))
+ ;; NOTE: This used to be (point-at-eol), but
+ ;; that was too close for multi-line arguments
+ ;; to a macro. Point max may be too far if there
+ ;; is a typo in the buffer.
+ ;;
+ ;; Look here for performance issues while a user is typing
+ ;; incomplete code.
+ (point-max)))
(setq end (semantic-lex-token-end arg-parsed))
(when (and (listp arg-parsed) (eq (car arg-parsed) 'semantic-list))
(defun semantic-lex-spp-analyzer-push-tokens-for-symbol (str beg end)
"Push lexical tokens for the symbol or keyword STR.
STR occurs in the current buffer between BEG and END."
- (let (sym val)
+ (let (sym val count)
(cond
;;
;; It is a macro. Prepare for a replacement.
(symbolp (car token))
(eq 'semantic-list (car token)))
;; Convert TOKEN in place.
- (let ((argsplit (cedet-split-string (semantic-lex-token-text token)
- "[(), ]" t)))
+ (let ((argsplit (split-string (semantic-lex-token-text token)
+ "[(), ]" t)))
(setcar token 'spp-arg-list)
(setcar (nthcdr 1 token) argsplit))
))
(nreverse toks)))))
+(defvar semantic-lex-spp-hack-depth 0
+ "Current depth of recursive calls to `semantic-lex-spp-lex-text-string'.")
+
(defun semantic-lex-spp-lex-text-string (text)
"Lex the text string TEXT using the current buffer's state.
Use this to parse text extracted from a macro as if it came from
the current buffer. Since the lexer is designed to only work in
a buffer, we need to create a new buffer, and populate it with rules
and variable state from the current buffer."
- (let* ((buf (get-buffer-create " *SPP parse hack*"))
+ (let* ((semantic-lex-spp-hack-depth (1+ semantic-lex-spp-hack-depth))
+ (buf (get-buffer-create (format " *SPP parse hack %d*"
+ semantic-lex-spp-hack-depth)))
(mode major-mode)
(fresh-toks nil)
(toks nil)
semantic-lex-spp-expanded-macro-stack
))
)
- (set-buffer buf)
- (erase-buffer)
- ;; Below is a painful hack to make sure everything is setup correctly.
- (when (not (eq major-mode mode))
- (funcall mode)
- ;; Hack in mode-local
- (activate-mode-local-bindings)
- ;; CHEATER! The following 3 lines are from
- ;; `semantic-new-buffer-fcn', but we don't want to turn
- ;; on all the other annoying modes for this little task.
- (setq semantic-new-buffer-fcn-was-run t)
- (semantic-lex-init)
- (semantic-clear-toplevel-cache)
- (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook
- t)
- ;; Second Cheat: copy key variables reguarding macro state from the
- ;; the originating buffer we are parsing.
- (dolist (V important-vars)
- (set V (semantic-buffer-local-value V origbuff)))
- )
- (insert text)
- (goto-char (point-min))
+ (if (> semantic-lex-spp-hack-depth 5)
+ nil
+ (with-current-buffer buf
+ (erase-buffer)
+ ;; Below is a painful hack to make sure everything is setup correctly.
+ (when (not (eq major-mode mode))
+ (save-match-data
+
+ ;; Protect against user-hooks that throw errors.
+ (condition-case nil
+ (funcall mode)
+ (error nil))
+
+ ;; Hack in mode-local
+ (activate-mode-local-bindings)
+
+ ;; CHEATER! The following 3 lines are from
+ ;; `semantic-new-buffer-fcn', but we don't want to turn
+ ;; on all the other annoying modes for this little task.
+ (setq semantic-new-buffer-fcn-was-run t)
+ (semantic-lex-init)
+ (semantic-clear-toplevel-cache)
+ (remove-hook 'semantic-lex-reset-hooks 'semantic-lex-spp-reset-hook
+ t)
+ ))
+
+ ;; Second Cheat: copy key variables regarding macro state from the
+ ;; the originating buffer we are parsing. We need to do this every time
+ ;; since the state changes.
+ (dolist (V important-vars)
+ (set V (semantic-buffer-local-value V origbuff)))
+ (insert text)
+ (goto-char (point-min))
- (setq fresh-toks (semantic-lex-spp-stream-for-macro (point-max)))
- (dolist (tok fresh-toks)
- (when (memq (semantic-lex-token-class tok) '(symbol semantic-list))
- (setq toks (cons tok toks))))
+ (setq fresh-toks (semantic-lex-spp-stream-for-macro (point-max))))
+
+ (dolist (tok fresh-toks)
+ (when (memq (semantic-lex-token-class tok) '(symbol semantic-list))
+ (setq toks (cons tok toks)))))
(nreverse toks)))
(defvar semantic-lex-spp-macro-max-length-to-save 200
"*Maximum length of an SPP macro before we opt to not save it.")
+;;;###autoload
(defun semantic-lex-spp-table-write-slot-value (value)
"Write out the VALUE of a slot for EIEIO.
The VALUE is a spp lexical table."
(prin1 (car sym))
(let* ((first (car (cdr sym)))
(rest (cdr sym)))
- (when (not (listp first))
- (error "Error in macro \"%s\"" (car sym)))
- (when (eq (car first) 'spp-arg-list)
- (princ " ")
- (prin1 first)
- (setq rest (cdr rest))
- )
-
- (when rest
- (princ " . ")
- (let ((len (length (cdr rest))))
- (cond ((< len 2)
- (condition-case nil
- (prin1 rest)
- (error
- (princ "nil ;; Error writing macro\n"))))
- ((< len semantic-lex-spp-macro-max-length-to-save)
- (princ "\n ")
- (condition-case nil
- (prin1 rest)
- (error
- (princ "nil ;; Error writing macro\n ")))
- )
- (t ;; Too Long!
- (princ "nil ;; Too Long!\n ")
- ))))
- )
- (princ ")\n ")
- )
- (princ ")\n"))
-)
-
-;;; TESTS
-;;
-(defun semantic-lex-spp-write-test ()
- "Test the semantic tag writer against the current buffer."
- (interactive)
- (with-output-to-temp-buffer "*SPP Write Test*"
- (semantic-lex-spp-table-write-slot-value
- (semantic-lex-spp-save-table))))
-
-(defun semantic-lex-spp-write-utest ()
- "Unit test using the test spp file to test the slot write fcn."
- (interactive)
- (let* ((sem (locate-library "semantic-lex-spp.el"))
- (dir (file-name-directory sem)))
- (save-excursion
- (set-buffer (find-file-noselect
- (expand-file-name "tests/testsppreplace.c"
- dir)))
- (semantic-lex-spp-write-test))))
+ (if (not (listp first))
+ (insert "nil ;; bogus macro found.\n")
+ (when (eq (car first) 'spp-arg-list)
+ (princ " ")
+ (prin1 first)
+ (setq rest (cdr rest)))
+
+ (when rest
+ (princ " . ")
+ (let ((len (length (cdr rest))))
+ (cond ((< len 2)
+ (condition-case nil
+ (prin1 rest)
+ (error
+ (princ "nil ;; Error writing macro\n"))))
+ ((< len semantic-lex-spp-macro-max-length-to-save)
+ (princ "\n ")
+ (condition-case nil
+ (prin1 rest)
+ (error
+ (princ "nil ;; Error writing macro\n "))))
+ (t ;; Too Long!
+ (princ "nil ;; Too Long!\n ")))))))
+ (princ ")\n "))
+ (princ ")\n")))
;;; MACRO TABLE DEBUG
;;
)
(def-edebug-spec define-lex-spp-include-analyzer
- (&define name stringp stringp form def-body)
- )
- ))
-
+ (&define name stringp stringp form def-body))))
(provide 'semantic/lex-spp)
+;; Local variables:
+;; generated-autoload-file: "loaddefs.el"
+;; generated-autoload-load-name: "semantic/lex-spp"
+;; End:
+
+;; arch-tag: 8877d83e-07ea-4d86-a960-e3562138d8a5
;;; semantic-lex-spp.el ends here
HCoop / bpt / emacs.git / blobdiff