1 ;;; grok-lisp.el --- Extract or graph sources with Emacs Semantic

2

3 ;; Copyright (C) 2007, 2008, 2009 Dmitry Dzhus

4

5 ;; Author: Dmitry Dzhus <dima@sphinx.net.ru>

6 ;; Keywords: lisp semantic graph

7

8 ;; This program is free software: you can redistribute it and/or

9 ;; modify it under the terms of the GNU General Public License as

10 ;; published by the Free Software Foundation, either version 3 of the

11 ;; License, or (at your option) any later version.

12

13 ;; This program is distributed in the hope that it will be useful,

14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of

15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

16 ;; GNU General Public License for more details.

17

18 ;; You should have received a copy of the GNU General Public License

19 ;; along with this program. If not, see

20 ;; <http://www.gnu.org/licenses/>.

21

22 ;;; Commentary:

23

24 ;; This package is to be used in Emacs batch mode. It is based on

25 ;; Semantic which is a part of CEDET package.

26 ;;

27 ;; Two principal features of this package are:

28 ;;

29 ;; 1. Printing contents of a specified tag from specified source code

30 ;; file:

31 ;;

32 ;; emacs --batch -l grok-lisp.el --exec '(print-tag-from-file "some-tag" "some-source.scm")' 2> /dev/null

33 ;;

34 ;; 2. Printing DOT definition for graph of «string dependencies»

35 ;; between all tags defined in source code file(s):

36 ;;

37 ;; emacs --batch -l grok-lisp.el --exec '(print-files-depgraph \'(function) "file1.el" "file2.el")' 2> /dev/null

38 ;;

39 ;; «Tags» are high-level entities which Semantic produces when parsing

40 ;; source code. Tags have classes like «include» or «function».

41 ;; `print-files-depgraph' requires a list of tag classes to consider

42 ;; when building dependency graph.

43 ;;

44 ;; For more information on how Semantic works and its API, please

45 ;; execute (info "(semantic-appdef)") in your Emacs.

46 ;;

47 ;; Under the hood, naïve approach to detecting dependencies is used:

48 ;; tag A is considered to be depending on B, if B is «mentioned» in

49 ;; the definition of A.

50 ;;

51 ;; Redirection to /dev/null is needed in order to get rid of messages

52 ;; Emacs displays when loading various libraries required by this

53 ;; package.

54

55 ;; This packages utilizes Semantic DB, so file dependencies are

56 ;; transparently handled as fully as it's possible.

57 ;;

58 ;; CEDET is work in progress, so result may vary with sources in

59 ;; different languages. It may not work at all with particular set of

60 ;; files.

61

62 ;; To see what this package is actually capable of, try using it upon

63 ;; _its own_ source! This command will print full definition of

64 ;; `get-tag-deps' function:

65 ;;

66 ;; emacs --batch -l grok-lisp.el --exec '(print-tag-from-file "get-tag-deps" "grok-lisp.el")' 2> /dev/null

67 ;;

68 ;; You may also generate dependency graph of functions defined in this

69 ;; file with the following command:

70 ;;

71 ;; emacs --batch -l grok-lisp.el --exec "(print-files-depgraph '(function) \"grok-lisp.el\")" 2> /dev/null

72

73 ;; Introductory article (in russian) discussing this package is

74 ;; available here: http://sphinx.net.ru/blog/entry/semantic-wizardry/

75

76 ;; This package has been tested with Emacs Lisp and Scheme sources. It

77 ;; contains a Lisp specific hack in `get-tag-deps', you may need to

78 ;; tweak it in order to parse sources in other languages.

79

80 ;; As of January 2009, this package is fully functional with GNU Emacs

81 ;; and CEDET, both of CVS versions.

82

83 ;;; Code:

84

85 (require 'semantic)

86 (require 'semanticdb)

87 (require 'semanticdb-mode)

88 (semanticdb-toggle-global-mode)

89

90 (defun get-file-tags (file-name)

91 "Return a Semantic tag table in FILE-NAME."

92 (with-current-buffer

93 (find-file-noselect file-name)

94 (semantic-fetch-tags)))

95

96 (defun get-tag-body (tag)

97 "Return full TAG source code as a string.

98

99 TAG is valid Semantic tag."

100 (let ((from (semantic-tag-start tag))

101 (to (semantic-tag-end tag))

102 (buffer (semantic-tag-buffer tag)))

103 (with-current-buffer buffer

104 (buffer-substring from to))))

105

106 (defun get-tag-deps (tag tag-table types)

107 "Scan TAG for tags which are also in TAG-TABLE.

108

109 Only tokens with one of specified TYPES are considered to be a

110 tag dependency."

111 (let ((from (semantic-tag-start tag))

112 (to (semantic-tag-end tag))

113 (buffer (semantic-tag-buffer tag))

114 ;; Build associative list with tag names as keys

115 (deps (mapcar

116 (lambda (tag)

117 (cons (semantic-tag-name tag)

118 tag))

119 tag-table)))

120 (with-current-buffer buffer

121 (let (result)

122 ;; cddddr is a Lisp-oriented hack to prevent tag itself from

123 ;; inclusion to its own dependency list

124 (dolist (lexem (cddddr (semantic-lex from to 1.0e+INF)) result)

125 (if (memq (car lexem) types)

126 (let* ((lexem-string (buffer-substring

127 (cadr lexem)

128 (cddr lexem)))

129 (found-tag (assoc lexem-string

130 deps)))

131 (if found-tag

132 (add-to-list 'result (cdr found-tag) t)))))))))

133

134 (defun print-tag-from-file (tag-name file-name)

135 "Print body of tag with TAG-NAME from FILE-NAME."

136 (interactive "sTag name: \nfFile name: ")

137 (let ((tag-table (get-file-tags file-name)))

138 (princ (format "%s"

139 (get-tag-body

140 (semantic-find-first-tag-by-name

141 tag-name

142 tag-table))))))

143

144 (defun get-file-tag-classes (file-name classes)

145 "Get a list of all tags declared in FILE-NAME which class is in CLASSES.

146

147 CLASSES is a list of Semantic classes."

148 (let ((result)

149 (all-tags (get-file-tags file-name)))

150 (dolist (tag-class classes result)

151 (setq result (append result

152 (semantic-find-tags-by-class

153 tag-class all-tags))))))

154

155 (defun get-file-tag-classes-deep (file-name classes)

156 "List all tags declared in FILE-NAME and includes which class is in CLASSES.

157

158 CLASSES is a list of Semantic classes.

159

160 Does the same as `get-file-tag-classes' taking included files

161 into account."

162 (with-current-buffer

163 (find-file-noselect file-name)

164 (let ((result))

165 (dolist (tag-class classes result)

166 (setq result (append result (semanticdb-strip-find-results

167 (semanticdb-find-tags-by-class tag-class))))))))

168

169 (defun get-file-depgraph (file-name classes)

170 "Extract from FILE-NAME tags of CLASSES with their dependencies.

171

172 CLASSES is a list of Semantic classes.

173

174 Return a list of pairs (TAG . DEPS) where DEPS is a list of

175 functions TAG depends on."

176 (let ((deep-tag-table (get-file-tag-classes-deep file-name classes))

177 (file-tag-table (get-file-tag-classes file-name classes))

178 (depgraph))

179 (dolist (tag file-tag-table depgraph)

180 (let ((deps (get-tag-deps tag deep-tag-table '(NAME symbol))))

181 (add-to-list 'depgraph (cons tag deps) t)))))

182

183 (defun print-files-depgraph (classes &rest file-names)

184 "Print depgraph with tags of CLASSES found in FILE-NAMES.

185

186 CLASSES is a list of Semantic classes (description of Semantic

187 classes is available in CEDET manual). Usually you'll use

188 `'(function)'.

189

190 FILE-NAMES are source code files to search for tags in.

191

192 Output format is DOT, so it's suitable for further processing

193 with Graphviz tools."

194 (princ "digraph D {\n")

195 (princ "overlap=scale;\n")

196 (dolist (file file-names)

197 (let ((depgraph (get-file-depgraph file classes)))

198 (dolist (dep-list-for-tag depgraph)

199 (let ((function-name (semantic-tag-name

200 (car dep-list-for-tag))))

201 (princ (format "\"%s\";\n" function-name))

202 (dolist (dependency (cdr dep-list-for-tag))

203 (princ (format "\"%s\" -> \"%s\";\n"

204 (semantic-tag-name dependency)

205 function-name)))))))

206 (princ "}\n"))

207

208 (provide 'grok-lisp)

209

210 ;;; grok-lisp.el ends here