Commit | Line | Data |
---|---|---|
4d902e6f CY |
1 | ;;; srecode/table.el --- Tables of Semantic Recoders |
2 | ||
114f9c96 | 3 | ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
4d902e6f 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 | ;; Semantic Recoder tables manage lists of templates and the major | |
25 | ;; modes they are associated with. | |
26 | ;; | |
27 | ||
28 | (require 'eieio) | |
29 | (require 'eieio-base) | |
30 | (require 'mode-local) | |
31 | (require 'srecode) | |
32 | ||
33 | (declare-function srecode-load-tables-for-mode "srecode/find") | |
b9749554 | 34 | (declare-function srecode-template-table-in-project-p "srecode/find") |
4d902e6f CY |
35 | |
36 | ;;; Code: | |
37 | ||
38 | ;;; TEMPLATE TABLE | |
39 | ;; | |
40 | (defclass srecode-template-table () | |
41 | (;; | |
42 | ;; Raw file tracking | |
43 | ;; | |
44 | (file :initarg :file | |
45 | :type string | |
46 | :documentation | |
47 | "The name of the file this table was built from.") | |
48 | (filesize :initarg :filesize | |
49 | :type number | |
50 | :documentation | |
51 | "The size of the file when it was parsed.") | |
52 | (filedate :initarg :filedate | |
53 | :type cons | |
54 | :documentation | |
55 | "Date from the inode of the file when it was last edited. | |
56 | Format is from the `file-attributes' function.") | |
57 | (major-mode :initarg :major-mode | |
58 | :documentation | |
59 | "The major mode this table of templates is associated with.") | |
60 | ;; | |
61 | ;; Template file sorting data | |
62 | ;; | |
63 | (application :initarg :application | |
64 | :type symbol | |
65 | :documentation | |
66 | "Tracks the name of the application these templates belong to. | |
67 | If this is nil, then this template table belongs to a set of generic | |
68 | templates that can be used with no additional dictionary values. | |
69 | When it is non-nil, it is assumed the template macros need specialized | |
c6f3804c | 70 | Emacs Lisp code to fill in the dictionary.") |
4d902e6f CY |
71 | (priority :initarg :priority |
72 | :type number | |
73 | :documentation | |
74 | "For file of this Major Mode, what is the priority of this file. | |
75 | When there are multiple template files with similar names, templates with | |
76 | the highest priority are scanned last, allowing them to override values in | |
77 | previous template files.") | |
b9749554 EL |
78 | (project :initarg :project |
79 | :type (or null string) | |
80 | :documentation | |
81 | "Scope some project files to a specific project. | |
82 | The value is a directory which forms the root of a particular project, | |
83 | or a subset of a particular project.") | |
4d902e6f CY |
84 | ;; |
85 | ;; Parsed Data from the template file | |
86 | ;; | |
87 | (templates :initarg :templates | |
88 | :type list | |
89 | :documentation | |
90 | "The list of templates compiled into this table.") | |
91 | (namehash :initarg :namehash | |
92 | :documentation | |
93 | "Hash table containing the names of all the templates.") | |
94 | (contexthash :initarg :contexthash | |
95 | :documentation | |
96 | "") | |
97 | (variables :initarg :variables | |
98 | :documentation | |
99 | "AList of variables. | |
100 | These variables are used to initialize dictionaries.") | |
101 | ) | |
102 | "Semantic recoder template table. | |
103 | A Table contains all templates from a single .srt file. | |
104 | Tracks various lookup hash tables.") | |
105 | ||
106 | ;;; MODE TABLE | |
107 | ;; | |
108 | (defvar srecode-mode-table-list nil | |
109 | "List of all the SRecode mode table classes that have been built.") | |
110 | ||
111 | (defclass srecode-mode-table (eieio-instance-tracker) | |
112 | ((tracking-symbol :initform 'srecode-mode-table-list) | |
113 | (major-mode :initarg :major-mode | |
114 | :documentation | |
115 | "Table of template tables for this major-mode.") | |
116 | (tables :initarg :tables | |
117 | :documentation | |
118 | "All the tables that have been defined for this major mode.") | |
119 | ) | |
120 | "Track template tables for a particular major mode. | |
121 | Tracks all the template-tables for a specific major mode.") | |
122 | ||
123 | (defun srecode-get-mode-table (mode) | |
124 | "Get the SRecoder mode table for the major mode MODE. | |
125 | Optional argument SOFT indicates to not make a new one if a table | |
126 | was not found." | |
127 | (let ((ans nil)) | |
128 | (while (and (not ans) mode) | |
129 | (setq ans (eieio-instance-tracker-find | |
130 | mode 'major-mode 'srecode-mode-table-list) | |
131 | mode (get-mode-local-parent mode))) | |
132 | ans)) | |
133 | ||
134 | (defun srecode-make-mode-table (mode) | |
135 | "Get the SRecoder mode table for the major mode MODE." | |
136 | (let ((old (eieio-instance-tracker-find | |
137 | mode 'major-mode 'srecode-mode-table-list))) | |
138 | (if old | |
139 | old | |
140 | (let* ((ms (if (stringp mode) mode (symbol-name mode))) | |
141 | (new (srecode-mode-table ms | |
142 | :major-mode mode | |
143 | :tables nil))) | |
144 | ;; Save this new mode table in that mode's variable. | |
145 | (eval `(setq-mode-local ,mode srecode-table ,new)) | |
146 | ||
147 | new)))) | |
148 | ||
149 | (defmethod srecode-mode-table-find ((mt srecode-mode-table) file) | |
150 | "Look in the mode table MT for a template table from FILE. | |
151 | Return nil if there was none." | |
152 | (object-assoc file 'file (oref mt tables))) | |
153 | ||
154 | (defun srecode-mode-table-new (mode file &rest init) | |
155 | "Create a new template table for MODE in FILE. | |
2f10955c | 156 | INIT are the initialization parameters for the new template table." |
4d902e6f CY |
157 | (let* ((mt (srecode-make-mode-table mode)) |
158 | (old (srecode-mode-table-find mt file)) | |
159 | (attr (file-attributes file)) | |
160 | (new (apply 'srecode-template-table | |
161 | (file-name-nondirectory file) | |
162 | :file file | |
163 | :filesize (nth 7 attr) | |
164 | :filedate (nth 5 attr) | |
165 | :major-mode mode | |
166 | init | |
167 | ))) | |
168 | ;; Whack the old table. | |
169 | (when old (object-remove-from-list mt 'tables old)) | |
170 | ;; Add the new table | |
171 | (object-add-to-list mt 'tables new) | |
172 | ;; Sort the list in reverse order. When other routines | |
173 | ;; go front-to-back, the highest priority items are put | |
174 | ;; into the search table first, allowing lower priority items | |
175 | ;; to be the items found in the search table. | |
176 | (object-sort-list mt 'tables (lambda (a b) | |
177 | (> (oref a :priority) | |
178 | (oref b :priority)))) | |
179 | ;; Return it. | |
180 | new)) | |
181 | ||
182 | (defun object-sort-list (object slot predicate) | |
183 | "Sort the items in OBJECT's SLOT. | |
184 | Use PREDICATE is the same as for the `sort' function." | |
185 | (when (slot-boundp object slot) | |
186 | (when (listp (eieio-oref object slot)) | |
187 | (eieio-oset object slot (sort (eieio-oref object slot) predicate))))) | |
188 | ||
189 | ;;; DEBUG | |
190 | ;; | |
191 | ;; Dump out information about the current srecoder compiled templates. | |
192 | ;; | |
193 | (defun srecode-dump-templates (mode) | |
194 | "Dump a list of the current templates for MODE." | |
195 | (interactive "sMode: ") | |
196 | (require 'srecode/find) | |
197 | (let ((modesym (cond ((string= mode "") | |
198 | major-mode) | |
199 | ((not (string-match "-mode" mode)) | |
200 | (intern-soft (concat mode "-mode"))) | |
201 | (t | |
202 | (intern-soft mode))))) | |
203 | (srecode-load-tables-for-mode modesym) | |
204 | (let ((tmp (srecode-get-mode-table modesym)) | |
205 | ) | |
206 | (if (not tmp) | |
207 | (error "No table found for mode %S" modesym)) | |
208 | (with-output-to-temp-buffer "*SRECODE DUMP*" | |
209 | (srecode-dump tmp)) | |
210 | ))) | |
211 | ||
212 | (defmethod srecode-dump ((tab srecode-mode-table)) | |
213 | "Dump the contents of the SRecode mode table TAB." | |
214 | (princ "MODE TABLE FOR ") | |
215 | (princ (oref tab :major-mode)) | |
216 | (princ "\n--------------------------------------------\n\nNumber of tables: ") | |
217 | (let ((subtab (oref tab :tables))) | |
218 | (princ (length subtab)) | |
219 | (princ "\n\n") | |
220 | (while subtab | |
221 | (srecode-dump (car subtab)) | |
222 | (setq subtab (cdr subtab))) | |
223 | )) | |
224 | ||
225 | (defmethod srecode-dump ((tab srecode-template-table)) | |
226 | "Dump the contents of the SRecode template table TAB." | |
227 | (princ "Template Table for ") | |
228 | (princ (object-name-string tab)) | |
229 | (princ "\nPriority: ") | |
230 | (prin1 (oref tab :priority)) | |
231 | (when (oref tab :application) | |
232 | (princ "\nApplication: ") | |
233 | (princ (oref tab :application))) | |
b9749554 EL |
234 | (when (oref tab :project) |
235 | (require 'srecode/find) ; For srecode-template-table-in-project-p | |
236 | (princ "\nProject Directory: ") | |
237 | (princ (oref tab :project)) | |
238 | (when (not (srecode-template-table-in-project-p tab)) | |
239 | (princ "\n ** Not Usable in this file. **"))) | |
4d902e6f CY |
240 | (princ "\n\nVariables:\n") |
241 | (let ((vars (oref tab variables))) | |
242 | (while vars | |
243 | (princ (car (car vars))) | |
244 | (princ "\t") | |
245 | (if (< (length (car (car vars))) 9) | |
246 | (princ "\t")) | |
247 | (prin1 (cdr (car vars))) | |
248 | (princ "\n") | |
249 | (setq vars (cdr vars)))) | |
250 | (princ "\n\nTemplates:\n") | |
251 | (let ((temp (oref tab templates))) | |
252 | (while temp | |
253 | (srecode-dump (car temp)) | |
254 | (setq temp (cdr temp)))) | |
255 | ) | |
256 | ||
257 | ||
258 | (provide 'srecode/table) | |
259 | ||
260 | ;;; srecode/table.el ends here | |
261 | ||
3999968a | 262 | ;; arch-tag: 547d2f1d-2694-49b3-ab13-b2cda6b25b4d |