Commit | Line | Data |
---|---|---|
55b522b2 | 1 | ;;; semantic/tag-write.el --- Write tags to a text stream |
a6de3d1a | 2 | |
73b0cd50 | 3 | ;; Copyright (C) 2008-2011 Free Software Foundation, Inc. |
a6de3d1a CY |
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 | |
2551831f | 31 | ;; that they conform to good semantic tag hygiene. |
a6de3d1a CY |
32 | ;; |
33 | ||
55b522b2 | 34 | (require 'semantic) |
a6de3d1a CY |
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 | |
5c5bbb19 | 161 | ;;;###autoload |
a6de3d1a CY |
162 | (defun semantic-tag-write-list-slot-value (value) |
163 | "Write out the VALUE of a slot for EIEIO. | |
164 | The VALUE is a list of tags." | |
165 | (if (not value) | |
166 | (princ "nil") | |
167 | (princ "\n '") | |
168 | (semantic-tag-write-tag-list value 10 t) | |
169 | )) | |
170 | ||
a6de3d1a | 171 | (provide 'semantic/tag-write) |
5c5bbb19 CY |
172 | |
173 | ;; Local variables: | |
174 | ;; generated-autoload-file: "loaddefs.el" | |
5c5bbb19 CY |
175 | ;; generated-autoload-load-name: "semantic/tag-write" |
176 | ;; End: | |
177 | ||
55b522b2 | 178 | ;;; semantic/tag-write.el ends here |