branch: scratch/javaimp-wip
commit 551b1a3a270612b06fec2db36026b1acebfe078d
Author: Filipp Gunbin <fgun...@fastmail.fm>
Commit: Filipp Gunbin <fgun...@fastmail.fm>
wip
---
javaimp-gradle.el | 10 ++++-
javaimp-maven.el | 11 +++++-
javaimp-parse.el | 89 +++++++++++++++++++++++++-----------------
javaimp-util.el | 59 ++++++++++++++++++----------
javaimp.el | 115 +++++++++++++++++++++++++++++++++++++++++-------------
5 files changed, 199 insertions(+), 85 deletions(-)
diff --git a/javaimp-gradle.el b/javaimp-gradle.el
index 85e3f2e..e99aab7 100644
--- a/javaimp-gradle.el
+++ b/javaimp-gradle.el
@@ -48,7 +48,15 @@ information."
(javaimp--gradle-module-from-alist alist file))
alists)))
;; first module is always root
- (javaimp--build-tree (car modules) nil modules)))
+ (message "Building tree for root: %s"
+ (javaimp-print-id (javaimp-module-id (car modules))))
+ (javaimp--build-tree (car modules) modules
+ ;; more or less reliable way to find children
+ ;; is to look for modules with "this" as the
+ ;; parent
+ (lambda (el tested)
+ (equal (javaimp-module-parent-id tested)
+ (javaimp-module-id el))))))
(defun javaimp--gradle-handler ()
(goto-char (point-min))
diff --git a/javaimp-maven.el b/javaimp-maven.el
index eee886f..e2c2118 100644
--- a/javaimp-maven.el
+++ b/javaimp-maven.el
@@ -87,7 +87,16 @@ resulting module trees."
modules)))
(cdr modules)))))
(mapcar (lambda (root)
- (javaimp--build-tree root nil modules))
+ (message "Building tree for root: %s"
+ (javaimp-print-id (javaimp-module-id root)))
+ (javaimp--build-tree
+ root modules
+ ;; more or less reliable way to find
+ ;; children is to look for modules with
+ ;; "this" as the parent
+ (lambda (el tested)
+ (equal (javaimp-module-parent-id tested)
+ (javaimp-module-id el)))))
roots))))
(defun javaimp--maven-effective-pom-handler ()
diff --git a/javaimp-parse.el b/javaimp-parse.el
index db58e0e..ca8a77c 100644
--- a/javaimp-parse.el
+++ b/javaimp-parse.el
@@ -37,17 +37,19 @@ present."
; method, statement, simple-statement, array, unknown
name
start
- open-brace)
+ open-brace
+ parent)
-(defconst javaimp--parse-class-keywords
+(defconst javaimp--parse-classlike-keywords
'("class" "interface" "enum"))
(defconst javaimp--parse-stmt-keywords
'("if" "for" "while" "switch" "try" "catch" "finally"
"static" ;static initializer block
))
-(defsubst javaimp--parse-is-class (scope)
- (member (symbol-name (javaimp-scope-type scope))
javaimp--parse-class-keywords))
+(defsubst javaimp--parse-is-classlike (scope)
+ (member (symbol-name (javaimp-scope-type scope))
+ javaimp--parse-classlike-keywords))
(defvar javaimp--arglist-syntax-table
(let ((st (make-syntax-table java-mode-syntax-table))) ;TODO don't depend
@@ -265,7 +267,7 @@ is unchanged."
"Attempts to parse 'class' / 'interface' / 'enum' scope. Some of
those may later become 'local-class' (see `javaimp--parse-scopes')."
(save-excursion
- (if (javaimp--parse-preceding (regexp-opt javaimp--parse-class-keywords
'words)
+ (if (javaimp--parse-preceding (regexp-opt
javaimp--parse-classlike-keywords 'words)
(nth 1 state))
(let* ((keyword-start (match-beginning 1))
(keyword-end (match-end 1))
@@ -394,7 +396,7 @@ nil then goes all the way up. Examines and sets property
;; find innermost enclosing open-bracket
(goto-char (nth 1 state))
(when (= (char-after) ?{)
- (let ((scope (get-text-property 'javaimp-parse-scope)))
+ (let ((scope (get-text-property (point) 'javaimp-parse-scope)))
(unless scope
(setq scope (run-hook-with-args-until-success
'javaimp--parse-scope-hook state))
@@ -407,15 +409,27 @@ nil then goes all the way up. Examines and sets property
;; if a class is enclosed in anything other than a class, then it
;; should be local
(let ((tmp res)
- in-local)
+ in-local parent)
(while tmp
- (if (javaimp--parse-is-class (car tmp))
+ (if (javaimp--parse-is-classlike (car tmp))
(when in-local
(setf (javaimp-scope-type (car tmp)) 'local-class))
(setq in-local t))
+ (setf (javaimp-scope-parent (car tmp)) parent)
+ (setq parent (car tmp))
(setq tmp (cdr tmp))))
res))
+
+;; Main
+
+(defun javaimp--parse-get-package ()
+ (goto-char (point-max))
+ (when (javaimp--parse-rsb-keyword
+ "^\\s-*package\\s-+\\([^;\n]+\\)\\s-*;" nil t 1)
+ (match-string 1)))
+
+
(defun javaimp--parse-all-scopes ()
"Parses all scopes in a buffer."
(goto-char (point-max))
@@ -427,50 +441,53 @@ nil then goes all the way up. Examines and sets property
;; Set props at this brace and all the way up
(javaimp--parse-scopes nil)))))
+(defun javaimp--parse-clean-all-scopes ()
+ (remove-text-properties (point-min) (point-max)
+ '(javaimp-parse-scope nil)))
-
-;; Main
-
-(defun javaimp--parse-get-package ()
- (goto-char (point-max))
- (when (javaimp--parse-rsb-keyword
- "^\\s-*package\\s-+\\([^;\n]+\\)\\s-*;" nil t 1)
- (match-string 1)))
(defun javaimp--parse-get-file-classes ()
(goto-char (point-max))
(let (match res)
(while (setq match (text-property-search-backward
'javaimp-parse-scope nil nil))
- (when (javaimp--parse-is-class (prop-match-value match))
+ (when (javaimp--parse-is-classlike (prop-match-value match))
(push (mapconcat #'javaimp-scope-name
(javaimp--parse-scopes nil)
".")
res)))))
-;; Imenu support
+(defun javaimp--parse-get-all-scopes()
+ (goto-char (point-max))
+ (let (res)
+ (while (setq match (text-property-search-backward
+ 'javaimp-parse-scope nil nil))
+ (push (prop-match-value match) res))
+ res))
-(defun javaimp-imenu-create-index ()
+(defun javaimp--parse-get-forest-for-imenu ()
(goto-char (point-max))
- (let (match methods top-classes)
+ (let (match methods classes top-classes)
(while (setq match (text-property-search-backward
'javaimp-parse-scope nil nil))
(let* ((scope (prop-match-value match))
- (parent (javaimp--parse-scopes 1)))
- (cond ((and (eq (javaimp-scope-type scope) 'method)
- (and parent (javaimp--parse-is-class parent)))
- ;; TODO store parent location in scope?; reuse
- ;; javaimp--build-tree; collect top-level classes
- )
- ;; TODO javaimp-imenu-group-methods - t / nil / qualified
-
- ;; create sub-alist for each enclosing scope, which must be
- ;; a class
- ;;
- ;; (INDEX-NAME . INDEX-POSITION)
- ;; (MENU-TITLE . SUB-ALIST)
-
- ;; TODO imenu function - to javaimp-scope-start, and
back-to-indentation
- )))))
+ (parent (javaimp-scope-parent scope)))
+ (cond (;; all methods
+ (and (eq (javaimp-scope-type scope) 'method)
+ (and parent (javaimp--parse-is-classlike parent)))
+ (push scope methods))
+ (;; all classes
+ (javaimp--parse-is-classlike scope)
+ (push scope classes)
+ (when (not (javaimp-scope-parent scope))
+ (push scope top-classes))))))
+ (mapcar
+ (lambda (class)
+ (message "Building tree for top-level class: %s"
+ (javaimp-scope-name class))
+ (javaimp--build-tree class (concat methods classes)
+ (lambda (el tested)
+ (equal el (javaimp-scope-parent tested)))))
+ top-classes)))
(provide 'javaimp-parse)
diff --git a/javaimp-util.el b/javaimp-util.el
index 1544cc4..5e63c01 100644
--- a/javaimp-util.el
+++ b/javaimp-util.el
@@ -140,19 +140,16 @@ buffer and returns its result"
;; Tree building & search
-(defun javaimp--build-tree (this parent-node all)
- (message "Building tree for module: %s" (javaimp-print-id (javaimp-module-id
this)))
- (let ((children
- ;; more or less reliable way to find children is to look for
- ;; modules with "this" as the parent
- (seq-filter (lambda (m)
- (equal (javaimp-module-parent-id m) (javaimp-module-id
this)))
- all)))
+(defun javaimp--build-tree (this all child-p &optional parent-node)
+ "Recursively builds tree for element THIS and its children.
+Children are those elements from ALL for which CHILD-P invoked
+with this element and tested element returns non-nil.
+PARENT-NODE is indented for recursive calls."
+ (let ((children (seq-filter (apply-partially child-p this) all)))
(let* ((this-node (make-javaimp-node
:parent parent-node
:children nil
:contents this))
- ;; recursively build child nodes
(child-nodes
(mapcar (lambda (child)
(javaimp--build-tree child this-node all))
@@ -160,35 +157,57 @@ buffer and returns its result"
(setf (javaimp-node-children this-node) child-nodes)
this-node)))
-(defun javaimp--find-node (predicate forest)
+(defun javaimp--find-node (predicate forest &optional unwrap)
(catch 'found
(dolist (tree forest)
- (javaimp--find-node-in-tree-1 tree predicate))))
+ (javaimp--find-node-in-tree-1 tree predicate unwrap))))
-(defun javaimp--find-node-in-tree-1 (tree predicate)
+(defun javaimp--find-node-in-tree-1 (tree predicate unwrap)
(when tree
(if (funcall predicate (javaimp-node-contents tree))
- (throw 'found tree))
+ (throw 'found
+ (if unwrap
+ (javaimp-node-contents tree)
+ tree)))
(dolist (child (javaimp-node-children tree))
- (javaimp--find-node-in-tree-1 child predicate))))
+ (javaimp--find-node-in-tree-1 child predicate unwrap))))
-(defun javaimp--collect-nodes (predicate forest)
+(defun javaimp--collect-nodes (predicate forest &optional unwrap)
(apply #'seq-concatenate 'list
(mapcar (lambda (tree)
- (javaimp--collect-nodes-from-tree tree predicate))
+ (javaimp--collect-nodes-from-tree tree predicate unwrap))
forest)))
-(defun javaimp--collect-nodes-from-tree (tree &optional predicate)
+(defun javaimp--collect-nodes-from-tree (tree predicate unwrap)
(when tree
- (append (when (or (not predicate)
- (funcall predicate (javaimp-node-contents tree)))
- (list tree))
+ (append (when (funcall predicate (javaimp-node-contents tree))
+ (list (if unwrap
+ (javaimp-node-contents tree)
+ tree)))
(apply #'seq-concatenate 'list
(mapcar (lambda (child)
(javaimp--collect-nodes-from-tree child predicate))
(javaimp-node-children tree))))))
+(defun javaimp--map-nodes (mapper forest &optional unwrap)
+ (mapcar (lambda (tree)
+ (javaimp--map-nodes-from-tree tree mapper unwrap))
+ forest))
+
+(defun javaimp--map-nodes-from-tree (tree mapper unwrap)
+ (when tree
+ (cons (let ((contents (funcall mapper (javaimp-node-contents tree))))
+ (if unwrap
+ contents
+ (make-javaimp-node
+ :parent (javaimp-node-parent tree)
+ :children (javaimp-node-children tree)
+ :contents mapped)))
+ (mapcar (lambda (child)
+ (javaimp--map-nodes-from-tree child mapper))
+ (javaimp-node-children tree)))))
+
(defun javaimp--get-root (node)
(while (javaimp-node-parent node)
(setq node (javaimp-node-parent node)))
diff --git a/javaimp.el b/javaimp.el
index eb996f3..3efdae4 100644
--- a/javaimp.el
+++ b/javaimp.el
@@ -303,13 +303,21 @@ any module file."
;; do not expose tree structure, return only modules
(defun javaimp-find-module (predicate)
- (let ((node (javaimp--find-node predicate javaimp-project-forest)))
- (and node
- (javaimp-node-contents node))))
+ "Returns first module in `javaimp-project-forest' for which
+PREDICATE returns non-nil."
+ (javaimp--find-node predicate javaimp-project-forest t))
(defun javaimp-collect-modules (predicate)
- (mapcar #'javaimp-node-contents
- (javaimp--collect-nodes predicate javaimp-project-forest)))
+ "Returns all modules in `javaimp-project-forest' for which
+PREDICATE returns non-nil."
+ (javaimp--collect-nodes predicate javaimp-project-forest t))
+
+(defun javaimp-map-modules (mapper)
+ "Applies MAPPER to all modules in `javaimp-project-forest' and
+returns the result as a tree-like structure: a list of
+conses (CONTENTS . CHILDREN) where CHILDREN have the same
+structure, and so on."
+ (javaimp--map-nodes mapper javaimp-project-forest t))
;;; Adding imports
@@ -564,6 +572,53 @@ is `ordinary' or `static'. Interactively, NEW-IMPORTS is
nil."
+;; Imenu support
+
+;;;###autoload
+(defun javaimp-imenu-create-index ()
+ (let ((forest (javaimp--parse-get-forest-for-imenu)))
+ (cond ((not javaimp-imenu-group-methods)
+ ;; just plain list of methods
+ (javaimp--collect-nodes
+ (lambda (scope)
+ (when (eq (javaimp-scope-type scope) 'method)
+ (javaimp-imenu--make-entry scope)))
+ forest t))
+ ((eq javaimp-imenu-group-methods 'qualified)
+ ;; list of qualified methods
+ (javaimp--collect-nodes
+ (lambda (scope)
+ (when (eq (javaimp-scope-type scope) 'method)
+ (let ((entry (javaimp-imenu--make-entry scope)))
+ ;; prepend parents to name
+ (while (setq scope (javaimp-scope-parent scope))
+ (setcar entry (concat (javaimp-scope-name scope)
+ "."
+ (car entry)))))))
+ forest t))
+ (t
+ ;; group methods inside their enclosing class
+ (javaimp--map-nodes
+ (lambda (scope)
+ (cond ((javaimp--parse-is-classlike scope)
+ ;; this will be a sub-alist's car
+ (javaimp-scope-name scope))
+ ((eq (javaimp-scope-type scope) 'method)
+ (javaimp-menu--make-entry scope))))
+ forest t)))))
+
+(defun javaimp-imenu--make-entry (scope)
+ (list (javaimp-scope-name scope)
+ (javaimp-scope-start scope)
+ #'javaimp-imenu--go
+ scope))
+
+(defun javaimp-imenu--go (scope)
+ (goto-char (javaimp-scope-start scope))
+ (back-to-indentation))
+
+
+
;; Misc
(defun javaimp-reset (arg)
@@ -612,33 +667,39 @@ start (`javaimp-scope-start') instead."
(javaimp-scope-start scope)
(javaimp-scope-open-brace scope)))))))
-(defun javaimp-help-scopes-at-point ()
- "Shows enclosing scopes at point in a *javaimp-scopes* buffer,
-which is first cleared."
- (interactive)
- (let* ((parse-sexp-ignore-comments t) ; FIXME remove with major mode
- (parse-sexp-lookup-properties nil)
- (scopes (save-excursion
- (javaimp--parse-scopes nil)))
- (file buffer-file-name)
- (pos (point))
- (buf (get-buffer-create "*javaimp-scopes*")))
+
+(defun javaimp-help-show-scopes (arg)
+ "Shows scopes in a *javaimp-scopes* buffer,
+which is first cleared. With a prefix arg, cleans all previously
+parsed scopes."
+ (interactive "P")
+ (when arg
+ (save-excursion
+ (javaimp--parse-clean-all-scopes)
+ (javaimp--parse-all-scopes)))
+ (let ((scopes (save-excursion
+ (javaimp--parse-get-all-scopes)))
+ (file buffer-file-name)
+ (buf (get-buffer-create "*javaimp-scopes*")))
(with-current-buffer buf
(setq buffer-read-only nil)
(erase-buffer)
- (insert (propertize (format "Scopes at position %d in file:\n %s\n\n"
- pos file)
+ (insert (propertize (format "%s\n\n" file)
'javaimp-help-file file))
(dolist (scope scopes)
- (insert (propertize
- (concat (symbol-name (javaimp-scope-type scope))
- " "
- (javaimp-scope-name scope)
- "\n")
- 'mouse-face 'highlight
- 'help-echo "mouse-2: go to this scope"
- 'javaimp-help-scope scope
- 'keymap javaimp-help-keymap)))
+ (let ((depth 0)
+ (tmp scope))
+ (while (setq tmp (javaimp-scope-parent tmp))
+ (setq depth (1+ depth)))
+ (insert (propertize
+ (format "%d: %010s %s\n"
+ depth
+ (symbol-name (javaimp-scope-type scope))
+ (javaimp-scope-name scope))
+ 'mouse-face 'highlight
+ 'help-echo "mouse-2: go to this scope"
+ 'javaimp-help-scope scope
+ 'keymap javaimp-help-keymap))))
(setq buffer-read-only t))
(display-buffer buf)))
