Mercurial > emacs
annotate lisp/cedet/semantic/tag-write.el @ 104476:1da44e87bf90
lisp/cedet/semantic/sort.el (semantic-tag-external-class-default)
(semantic-tag-external-member-children-default): Require
semantic/db-mode instead of checking if semanticdb-minor-mode-p is
bound.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Mon, 07 Sep 2009 16:34:35 +0000 |
parents | df08b7ab0ba0 |
children | ee206d5b836f |
rev | line source |
---|---|
104446
df08b7ab0ba0
lisp/cedet/semantic/analyze.el: Add local vars for autoloading.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
1 ;;; semantic/tag-write.el --- Write tags to a text stream |
104421 | 2 |
3 ;; Copyright (C) 2008, 2009 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com> | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software: you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published by | |
11 ;; the Free Software Foundation, either version 3 of the License, or | |
12 ;; (at your option) any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, | |
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
17 ;; GNU General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
21 | |
22 ;;; Commentary: | |
23 ;; | |
24 ;; Routine for writing out a list of tags to a text stream. | |
25 ;; | |
26 ;; These routines will be used by semanticdb to output a tag list into | |
27 ;; a text stream to be saved to a file. Ideally, you could use tag streams | |
28 ;; to share tags between processes as well. | |
29 ;; | |
30 ;; As a bonus, these routines will also validate the tag structure, and make sure | |
31 ;; that they conform to good semantic tag hygene. | |
32 ;; | |
33 | |
104446
df08b7ab0ba0
lisp/cedet/semantic/analyze.el: Add local vars for autoloading.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
34 (require 'semantic) |
104421 | 35 |
36 ;;; Code: | |
37 (defun semantic-tag-write-one-tag (tag &optional indent) | |
38 "Write a single tag TAG to standard out. | |
39 INDENT is the amount of indentation to use for this tag." | |
40 (when (not (semantic-tag-p tag)) | |
41 (signal 'wrong-type-argument (list tag 'semantic-tag-p))) | |
42 (when (not indent) (setq indent 0)) | |
43 ;(princ (make-string indent ? )) | |
44 (princ "(\"") | |
45 ;; Base parts | |
46 (let ((name (semantic-tag-name tag)) | |
47 (class (semantic-tag-class tag))) | |
48 (princ name) | |
49 (princ "\" ") | |
50 (princ (symbol-name class)) | |
51 ) | |
52 (let ((attr (semantic-tag-attributes tag)) | |
53 ) | |
54 ;; Attributes | |
55 (cond ((not attr) | |
56 (princ " nil")) | |
57 | |
58 ((= (length attr) 2) ;; One item | |
59 (princ " (") | |
60 (semantic-tag-write-one-attribute attr indent) | |
61 (princ ")") | |
62 ) | |
63 (t | |
64 ;; More than one tag. | |
65 (princ "\n") | |
66 (princ (make-string (+ indent 3) ? )) | |
67 (princ "(") | |
68 (while attr | |
69 (semantic-tag-write-one-attribute attr (+ indent 4)) | |
70 (setq attr (cdr (cdr attr))) | |
71 (when attr | |
72 (princ "\n") | |
73 (princ (make-string (+ indent 4) ? ))) | |
74 ) | |
75 (princ ")\n") | |
76 (princ (make-string (+ indent 3) ? )) | |
77 )) | |
78 ;; Properties - for now, always nil. | |
79 (let ((rs (semantic--tag-get-property tag 'reparse-symbol))) | |
80 (if (not rs) | |
81 (princ " nil") | |
82 ;; Else, put in the property list. | |
83 (princ " (reparse-symbol ") | |
84 (princ (symbol-name rs)) | |
85 (princ ")")) | |
86 )) | |
87 ;; Overlay | |
88 (if (semantic-tag-with-position-p tag) | |
89 (let ((bounds (semantic-tag-bounds tag))) | |
90 (princ " ") | |
91 (prin1 (apply 'vector bounds)) | |
92 ) | |
93 (princ " nil")) | |
94 ;; End it. | |
95 (princ ")") | |
96 ) | |
97 | |
98 (defun semantic-tag-write-tag-list (tlist &optional indent dontaddnewline) | |
99 "Write the tag list TLIST to the current stream. | |
100 INDENT indicates the current indentation level. | |
101 If optional DONTADDNEWLINE is non-nil, then don't add a newline." | |
102 (if (not indent) | |
103 (setq indent 0) | |
104 (unless dontaddnewline | |
105 ;; Assume cursor at end of current line. Add a CR, and make the list. | |
106 (princ "\n") | |
107 (princ (make-string indent ? )))) | |
108 (princ "( ") | |
109 (while tlist | |
110 (if (semantic-tag-p (car tlist)) | |
111 (semantic-tag-write-one-tag (car tlist) (+ indent 2)) | |
112 ;; If we don't have a tag in the tag list, use the below hack, and hope | |
113 ;; it doesn't contain anything bad. If we find something bad, go back here | |
114 ;; and start extending what's expected here. | |
115 (princ (format "%S" (car tlist)))) | |
116 (setq tlist (cdr tlist)) | |
117 (when tlist | |
118 (princ "\n") | |
119 (princ (make-string (+ indent 2) ? ))) | |
120 ) | |
121 (princ ")") | |
122 (princ (make-string indent ? )) | |
123 ) | |
124 | |
125 | |
126 ;; Writing out random stuff. | |
127 (defun semantic-tag-write-one-attribute (attrs indent) | |
128 "Write out one attribute from the head of the list of attributes ATTRS. | |
129 INDENT is the current amount of indentation." | |
130 (when (not attrs) (signal 'wrong-type-argument (list 'listp attrs))) | |
131 (when (not (symbolp (car attrs))) (error "Bad Attribute List in tag")) | |
132 | |
133 (princ (symbol-name (car attrs))) | |
134 (princ " ") | |
135 (semantic-tag-write-one-value (car (cdr attrs)) indent) | |
136 ) | |
137 | |
138 (defun semantic-tag-write-one-value (value indent) | |
139 "Write out a VALUE for something in a tag. | |
140 INDENT is the current tag indentation. | |
141 Items that are long lists of tags may need their own line." | |
142 (cond | |
143 ;; Another tag. | |
144 ((semantic-tag-p value) | |
145 (semantic-tag-write-one-tag value (+ indent 2))) | |
146 ;; A list of more tags | |
147 ((and (listp value) (semantic-tag-p (car value))) | |
148 (semantic-tag-write-tag-list value (+ indent 2)) | |
149 ) | |
150 ;; Some arbitrary data. | |
151 (t | |
152 (let ((str (format "%S" value))) | |
153 ;; Protect against odd data types in tags. | |
154 (if (= (aref str 0) ?#) | |
155 (progn | |
156 (princ "nil") | |
157 (message "Warning: Value %s not writable in tag." str)) | |
158 (princ str))))) | |
159 ) | |
160 ;;; EIEIO USAGE | |
161 (defun semantic-tag-write-list-slot-value (value) | |
162 "Write out the VALUE of a slot for EIEIO. | |
163 The VALUE is a list of tags." | |
164 (if (not value) | |
165 (princ "nil") | |
166 (princ "\n '") | |
167 (semantic-tag-write-tag-list value 10 t) | |
168 )) | |
169 | |
170 ;;; TESTING. | |
171 | |
172 (defun semantic-tag-write-test () | |
173 "Test the semantic tag writer against the tag under point." | |
174 (interactive) | |
175 (with-output-to-temp-buffer "*Tag Write Test*" | |
176 (semantic-tag-write-one-tag (semantic-current-tag)))) | |
177 | |
178 (defun semantic-tag-write-list-test () | |
179 "Test the semantic tag writer against the tag under point." | |
180 (interactive) | |
181 (with-output-to-temp-buffer "*Tag Write Test*" | |
182 (semantic-tag-write-tag-list (semantic-fetch-tags)))) | |
183 | |
184 | |
185 (provide 'semantic/tag-write) | |
104446
df08b7ab0ba0
lisp/cedet/semantic/analyze.el: Add local vars for autoloading.
Chong Yidong <cyd@stupidchicken.com>
parents:
104421
diff
changeset
|
186 ;;; semantic/tag-write.el ends here |