diff --git a/semantic-matlab.el b/semantic-matlab.el index 7b00b46..6c1b211 100644 --- a/semantic-matlab.el +++ b/semantic-matlab.el @@ -84,13 +84,88 @@ completions.") "^\\s-*\\(classdef\\|function\\)\\>" "Regexp to identify if a file represents a class or a function.") +(defun semantic-matlab-guess-buffer-type (&optional buffer) + "Guess what kind of MATLAB content BUFFER contains. +Looks @ first declaration to determine if it is a class or function." + (save-excursion + (if buffer (set-buffer buffer)) + (goto-char (point-min)) + (if (re-search-forward semantic-matlab-match-filetype-re nil t) + (let ((key (match-string 1))) + (cond ((string= key "classdef") + 'class) + ((string= key "function") + 'function))) + 'script))) + ;;; TAG MATCHING ;; ;; CLASS Defintions (defvar semantic-matlab-match-classdef-re - "^\\s-*classdef\\b\\s-*\\(?:([^\n)])\\)?\\s-*\\(\\w+\\>\\)" + "^\\s-*classdef\\b\\s-*\\(?:([^\n)]+)\\)?\\s-*\\<\\(?2:\\w+\\)\\>" "Expression to match a class definition start") +(defun semantic-matlab-class-tags (&optional buffer) + "Find the MATLAB class tag, and all methods (functions) in BUFFER. +Return argument is: + (START END NAME BASECLASSES DOCSTRING METHODS LOCALFCN)." + (save-excursion + (if buffer (set-buffer buffer)) + (let ((re semantic-matlab-match-classdef-re) + start cn end doc base meth + (taglist nil) + ) + (goto-char (point-min)) + (when (re-search-forward re nil t) + (setq start (match-beginning 0) + cn (buffer-substring-no-properties + (match-beginning 2) (match-end 2)) + base nil ;; TODO + doc (save-excursion + (forward-line) + (beginning-of-line) + ;; snarf doc string + (cond + ;; Mathworks standard + ((looking-at "%[A-Z0-9_]+\\s-+\\(.*\\)\\s-*$") + (match-string-no-properties 1)) + ;; lookfor string + ((looking-at "%\\s-+\\(.*\\)\\s-*$") + (match-string-no-properties 1)) + ;; otherwise simply snarf first line of + ;; comments under function declaration + (t + (re-search-forward "[^[:blank:][:cntrl:]]" nil t) + (backward-char) + (if (looking-at "%\\s-+\\(.*\\)") + (match-string-no-properties 1) + nil)))) + end (save-excursion + (goto-char start) + (if matlab-functions-have-end + (condition-case nil + ;; If we get a failure, we should at least + ;; return whatever we got so far. + (matlab-forward-sexp) + (error (point-max))) + (matlab-end-of-defun)) + (point)) + meth (semantic-matlab-sort-raw-function-tags (semantic-matlab-function-tags) + end) + ) + (setq taglist + (cons (list start end + cn + base + doc + (car meth) + (car (semantic-matlab-sort-raw-function-tags (car (cdr meth)) (point-max))) + ) + taglist)) + ) + (nreverse taglist)))) + + ;; FUNCTION Definitions ;; The version of this variable in MATLAB.el is not a condusive to extracting @@ -248,9 +323,14 @@ IGNORE any arguments which specify a subregion to parse. Each tag returned is a semantic FUNCTION tag. See `semantic-tag-new-function'." (semanticdb-matlab-cache-files) - (let ((raw (condition-case nil - ;; Errors from here ought not to be propagated. - (semantic-matlab-parse-functions) + (let* ((bt (semantic-matlab-guess-buffer-type)) + (raw (condition-case nil + ;; Errors from here ought not to be propagated. + (cond ((eq bt 'class) + (semantic-matlab-parse-class)) + ((eq bt 'function) + (semantic-matlab-parse-functions)) + (t nil)) (error nil))) tags ctags) (setq tags (mapcar 'semantic-matlab-expand-tag raw)) @@ -266,6 +346,13 @@ Each tag returned is a semantic FUNCTION tag. See ;; To be implemented later. (semantic-parse-tree-set-needs-rebuild)) +(define-mode-local-override semantic-tag-components-with-overlays + matlab-mode (tag) + "Return the list of subfunctions, or class members in TAG." + (or + (semantic-tag-get-attribute tag :members) + (semantic-tag-get-attribute tag :subfunctions))) + (defun semantic-matlab-expand-tag (tag) "Expand the MATLAB function tag TAG." (let ((chil (semantic-tag-components-with-overlays tag))) @@ -274,14 +361,42 @@ Each tag returned is a semantic FUNCTION tag. See tag :members (mapcar 'semantic-matlab-expand-tag chil))) (car (semantic--tag-expand tag)))) +(defun semantic-matlab-parse-class (&optional limit) + "Pase the class from the current MATLAB buffer." + (semantic-matlab-sort-raw-class-tags (semantic-matlab-class-tags))) + +(defun semantic-matlab-sort-raw-class-tags (tag-list) + "Return a split list of tags from TAG-LIST before END." + (let ((newlist nil)) + (dolist (tag tag-list) + (let ((start (car tag)) + (end (nth 1 tag)) + (name (nth 2 tag)) + (base (nth 3 tag)) + (doc (nth 4 tag)) + (meth (nth 5 tag)) + (local (nth 6 tag))) + (setq newlist + (cons (append + (semantic-tag-new-type name + "class" + meth + base + :documentation doc) + (list start end)) + newlist)) + (setq newlist (append newlist local)) + )) + newlist)) + (defun semantic-matlab-parse-functions () "Parse all functions from the current MATLAB buffer." (car - (semantic-matlab-sort-raw-tags (semantic-matlab-function-tags) - (point-max)) + (semantic-matlab-sort-raw-function-tags (semantic-matlab-function-tags) + (or limit (point-max))) )) -(defun semantic-matlab-sort-raw-tags (tag-list &optional end) +(defun semantic-matlab-sort-raw-function-tags (tag-list &optional end) "Return a split list of tags from TAG-LIST before END. Return list is: (TAGS-BEFORE-END REMAINING-TAGS)" @@ -297,7 +412,7 @@ Return list is: (args (nth 4 tag)) (doc (nth 5 tag)) (builtin (nth 6 tag)) - (parts (semantic-matlab-sort-raw-tags (cdr tag-list) end)) + (parts (semantic-matlab-sort-raw-function-tags (cdr tag-list) end)) (chil (car parts))) (setq rest (car (cdr parts))) (setq newlist @@ -480,11 +595,6 @@ where NAME is unique." tags))) -(define-mode-local-override semantic-tag-components-with-overlays - matlab-mode (tag) - "Return the list of subfunctions in TAG." - (semantic-tag-get-attribute tag :subfunctions)) - (define-mode-local-override semantic-format-tag-prototype matlab-mode (tag &optional parent color) "Return a prototype string describing tag. diff --git a/tests/metest.el b/tests/metest.el index a50222d..b3813c0 100644 --- a/tests/metest.el +++ b/tests/metest.el @@ -31,6 +31,12 @@ (add-to-list 'load-path (expand-file-name d) t)) (require 'matlab) +(require 'cedet-matlab) +(require 'semantic-matlab) + +;; Enable semantic +(semantic-mode 1) +(matlab-cedet-setup) (defun metest-all-syntax-tests () "Run all the syntax tests in this file." @@ -38,6 +44,7 @@ (metest-sexp-counting-test) (metest-sexp-traversal-test) (metest-indents-test) + (metest-parse-test) ) (defvar met-stringtest-files '("strings.m") @@ -191,6 +198,58 @@ )) (message "")) +(defvar met-parser-files '("mpclass.m") + "List of files for running semantic parsing tests.") + +(defun metest-parse-test () + "Run the semantic parsing test to make sure the parse works." + + (dolist (F met-parser-files) + (let ((buf (find-file-noselect (expand-file-name F met-testfile-path))) + exp act + (cnt 0)) + (save-excursion + (set-buffer buf) + + ;; Prep buffer for test + (semantic-idle-scheduler-mode -1) + (semantic-clear-toplevel-cache) + + ;; Do the test + (goto-char (point-min)) + (message ">> Starting semantic parser test in %S" (current-buffer)) + + (unless (re-search-forward "^%%\\s-*>>\\s-+SEMANTIC TEST" nil t) + (error "Semantic parser test: Failed to find test cookie.")) + (unless (re-search-forward "^%{[ \t\n]+\\(((\\)" nil t) + (error "Semantic parser test: Failed to find expected values.")) + (goto-char (match-beginning 1)) + (setq exp (read (buffer-substring (point) + (save-excursion (re-search-forward "%}" nil t) + (match-beginning 0))))) + (setq act (semantic-fetch-tags)) + + ;; Compare the two lists ... simply. + (while (and exp act) + (unless (metest-compare-tags (car exp) (car act)) + (error "Expected tag %s, found %s" (semantic-format-tag-prototype (car exp)) + (semantic-format-tag-prototype (car act)))) + (setq exp (cdr exp) act (cdr act) cnt (1+ cnt)) + ) + (when (or exp act) + (error "Found tags and expected tag lists differnet lengths.\nExpected Remains: %S\nActual Remains: %S" + exp act)) + + ) + + (message ">> Semantic parser test: %d tags matched" cnt)))) + + +(defun metest-compare-tags (EXP ACT) + "Return non-nil if EXP tag is similiar to ACT" + (semantic-tag-similar-p EXP ACT :documentation) + + ) (provide 'metest) diff --git a/tests/mpclass.m b/tests/mpclass.m new file mode 100644 index 0000000..2ace845 --- /dev/null +++ b/tests/mpclass.m @@ -0,0 +1,50 @@ +classdef (abstract) mpclass < handle & matlab.mixin.SetGetExactNames + + properties + X + Y + end + + properties (Access='private') + A + B + end + + methods + function obj = mpclass(x, y) + % Parsetest constructor + obj.X = x; + obj.Y = y; + end + + function do_thing(obj, a, b) + % Do a thing for the parse test + obj.A = a; + obj.B = b; + + localfunc('hello'); + end + + end + +end + +function localfunc(T) +% Local functions are handy. + disp(T); +end + +%% >> SEMANTIC TEST EXPECTED OUTPUT + +%{ +(( "mpclass" type + ( :type "class" + :members ( + ("mpclass" function ( + :return ("obj") + :arguments ("x" "y"))) + ("do_thing" function ( + :arguments ("obj" "a" "b")))))) + ("localfunc" function ( + :arguments ("T")))) +%} \ No newline at end of file