]> code.delx.au - gnu-emacs/blob - lisp/cedet/semantic/chart.el
cedet/semantic/chart.el: Don't require semantic/find.
[gnu-emacs] / lisp / cedet / semantic / chart.el
1 ;;; semantic/chart.el --- Utilities for use with semantic tag tables
2
3 ;;; Copyright (C) 1999, 2000, 2001, 2003, 2005, 2008, 2009
4 ;;; Free Software Foundation, Inc.
5
6 ;; Author: Eric M. Ludlam <zappo@gnu.org>
7
8 ;; This file is part of GNU Emacs.
9
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
14
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22
23 ;;; Commentary:
24 ;;
25 ;; A set of simple functions for charting details about a file based on
26 ;; the output of the semantic parser.
27 ;;
28
29 (require 'chart)
30 (require 'semantic)
31 (require 'semantic/db-mode)
32 (require 'semantic/db-typecache)
33 (require 'semantic/scope)
34
35 ;;; Code:
36
37 (defun semantic-chart-tags-by-class (&optional tagtable)
38 "Create a bar chart representing the number of tags for a given tag class.
39 Each bar represents how many toplevel tags in TAGTABLE
40 exist with a given class. See `semantic-symbol->name-assoc-list'
41 for tokens which will be charted.
42 TAGTABLE is passedto `semantic-something-to-tag-table'."
43 (interactive)
44 (let* ((stream (semantic-something-to-tag-table
45 (or tagtable (current-buffer))))
46 (names (mapcar 'cdr semantic-symbol->name-assoc-list))
47 (nums (mapcar
48 (lambda (symname)
49 (length
50 (semantic-brute-find-tag-by-class (car symname)
51 stream)
52 ))
53 semantic-symbol->name-assoc-list)))
54 (chart-bar-quickie 'vertical
55 "Semantic Toplevel Tag Volume"
56 names "Tag Class"
57 nums "Volume")
58 ))
59
60 (defun semantic-chart-database-size (&optional tagtable)
61 "Create a bar chart representing the size of each file in semanticdb.
62 Each bar represents how many toplevel tags in TAGTABLE
63 exist in each database entry.
64 TAGTABLE is passed to `semantic-something-to-tag-table'."
65 (interactive)
66 (if (or (not (fboundp 'semanticdb-minor-mode-p))
67 (not (semanticdb-minor-mode-p)))
68 (error "Semanticdb is not enabled"))
69 (let* ((db semanticdb-current-database)
70 (dbt (semanticdb-get-database-tables db))
71 (names (mapcar 'car
72 (object-assoc-list
73 'file
74 dbt)))
75 (numnuts (mapcar (lambda (dba)
76 (prog1
77 (cons
78 (if (slot-boundp dba 'tags)
79 (length (oref dba tags))
80 1)
81 (car names))
82 (setq names (cdr names))))
83 dbt))
84 (nums nil)
85 (fh (/ (- (frame-height) 7) 4)))
86 (setq numnuts (sort numnuts (lambda (a b) (> (car a) (car b)))))
87 (setq names (mapcar 'cdr numnuts)
88 nums (mapcar 'car numnuts))
89 (if (> (length names) fh)
90 (progn
91 (setcdr (nthcdr fh names) nil)
92 (setcdr (nthcdr fh nums) nil)))
93 (chart-bar-quickie 'horizontal
94 "Semantic DB Toplevel Tag Volume"
95 names "File"
96 nums "Volume")
97 ))
98
99 (defun semantic-chart-token-complexity (tok)
100 "Calculate the `complexity' of token TOK."
101 (count-lines
102 (semantic-tag-end tok)
103 (semantic-tag-start tok)))
104
105 (defun semantic-chart-tag-complexity
106 (&optional class tagtable)
107 "Create a bar chart representing the complexity of some tags.
108 Complexity is calculated for tags of CLASS. Each bar represents
109 the complexity of some tag in TAGTABLE. Only the most complex
110 items are charted. TAGTABLE is passedto
111 `semantic-something-to-tag-table'."
112 (interactive)
113 (let* ((sym (if (not class) 'function))
114 (stream
115 (semantic-find-tags-by-class
116 sym (semantic-something-to-tag-table (or tagtable
117 (current-buffer)))
118 ))
119 (name (cond ((semantic-tag-with-position-p (car stream))
120 (buffer-name (semantic-tag-buffer (car stream))))
121 (t "")))
122 (cplx (mapcar (lambda (tok)
123 (cons tok (semantic-chart-token-complexity tok)))
124 stream))
125 (namelabel (cdr (assoc 'function semantic-symbol->name-assoc-list)))
126 (names nil)
127 (nums nil))
128 (setq cplx (sort cplx (lambda (a b) (> (cdr a) (cdr b)))))
129 (while (and cplx (<= (length names) (/ (- (frame-height) 7) 4)))
130 (setq names (cons (semantic-tag-name (car (car cplx)))
131 names)
132 nums (cons (cdr (car cplx)) nums)
133 cplx (cdr cplx)))
134 ;; ;; (setq names (mapcar (lambda (str)
135 ;; ;; (substring str (- (length str) 10)))
136 ;; ;; names))
137 (chart-bar-quickie 'horizontal
138 (format "%s Complexity in %s"
139 (capitalize (symbol-name sym))
140 name)
141 names namelabel
142 nums "Complexity (Lines of code)")
143 ))
144
145 (defun semantic-chart-analyzer ()
146 "Chart the extent of the context analysis."
147 (interactive)
148 (let* ((p (semanticdb-find-translate-path nil nil))
149 (plen (length p))
150 (tab semanticdb-current-table)
151 (tc (semanticdb-get-typecache tab))
152 (tclen (+ (length (oref tc filestream))
153 (length (oref tc includestream))))
154 (scope (semantic-calculate-scope))
155 (fslen (length (oref scope fullscope)))
156 (lvarlen (length (oref scope localvar)))
157 )
158 (chart-bar-quickie 'vertical
159 (format "Analyzer Overhead in %s" (buffer-name))
160 '("includes" "typecache" "scopelen" "localvar")
161 "Overhead Entries"
162 (list plen tclen fslen lvarlen)
163 "Number of tags")
164 ))
165
166
167
168 (provide 'semantic/chart)
169
170 ;;; semantic/chart.el ends here