Commit | Line | Data |
---|---|---|
4d902e6f CY |
1 | ;;; srecode/map.el --- Manage a template file map |
2 | ||
acaf905b | 3 | ;; Copyright (C) 2008-2012 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 | ;; Read template files, and build a map of where they can be found. | |
25 | ;; Save the map to disk, and refer to it when bootstrapping a new | |
26 | ;; Emacs session with srecode. | |
27 | ||
28 | (require 'semantic) | |
29 | (require 'eieio-base) | |
30 | (require 'srecode) | |
31 | ||
32 | ;;; Code: | |
33 | ||
34 | ;; The defcustom is given at the end of the file. | |
35 | (defvar srecode-map-load-path) | |
36 | ||
37 | (defun srecode-map-base-template-dir () | |
38 | "Find the base template directory for SRecode." | |
e6e267fc | 39 | (expand-file-name "srecode" data-directory)) |
4d902e6f CY |
40 | \f |
41 | ;;; Current MAP | |
42 | ;; | |
43 | ||
44 | (defvar srecode-current-map nil | |
2f10955c | 45 | "The current map for global SRecode templates.") |
4d902e6f | 46 | |
2f79fdf0 | 47 | (defcustom srecode-map-save-file |
0fd9cb9c | 48 | (locate-user-emacs-file "srecode-map.el" ".srecode/srecode-map") |
4d902e6f CY |
49 | "The save location for SRecode's map file. |
50 | If the save file is nil, then the MAP is not saved between sessions." | |
51 | :group 'srecode | |
52 | :type 'file) | |
53 | ||
54 | (defclass srecode-map (eieio-persistent) | |
55 | ((fileheaderline :initform ";; SRECODE TEMPLATE MAP") | |
56 | (files :initarg :files | |
57 | :initform nil | |
58 | :type list | |
59 | :documentation | |
60 | "An alist of files and the major-mode that they cover.") | |
61 | (apps :initarg :apps | |
62 | :initform nil | |
63 | :type list | |
64 | :documentation | |
65 | "An alist of applications. | |
66 | Each app keys to an alist of files and modes (as above.)") | |
67 | ) | |
68 | "A map of srecode templates.") | |
69 | ||
70 | (defmethod srecode-map-entry-for-file ((map srecode-map) file) | |
71 | "Return the entry in MAP for FILE." | |
72 | (assoc file (oref map files))) | |
73 | ||
74 | (defmethod srecode-map-entries-for-mode ((map srecode-map) mode) | |
75 | "Return the entries in MAP for major MODE." | |
76 | (let ((ans nil)) | |
77 | (dolist (f (oref map files)) | |
78 | (when (mode-local-use-bindings-p mode (cdr f)) | |
79 | (setq ans (cons f ans)))) | |
80 | ans)) | |
81 | ||
82 | (defmethod srecode-map-entry-for-app ((map srecode-map) app) | |
83 | "Return the entry in MAP for APP'lication." | |
84 | (assoc app (oref map apps)) | |
85 | ) | |
86 | ||
87 | (defmethod srecode-map-entries-for-app-and-mode ((map srecode-map) app mode) | |
88 | "Return the entries in MAP for major MODE." | |
89 | (let ((ans nil) | |
90 | (appentry (srecode-map-entry-for-app map app))) | |
91 | (dolist (f (cdr appentry)) | |
92 | (when (eq (cdr f) mode) | |
93 | (setq ans (cons f ans)))) | |
94 | ans)) | |
95 | ||
96 | (defmethod srecode-map-entry-for-file-anywhere ((map srecode-map) file) | |
97 | "Search in all entry points in MAP for FILE. | |
98 | Return a list ( APP . FILE-ASSOC ) where APP is nil | |
99 | in the global map." | |
100 | (or | |
101 | ;; Look in the global entry | |
102 | (let ((globalentry (srecode-map-entry-for-file map file))) | |
103 | (when globalentry | |
104 | (cons nil globalentry))) | |
105 | ;; Look in each app. | |
106 | (let ((match nil)) | |
107 | (dolist (app (oref map apps)) | |
108 | (let ((appmatch (assoc file (cdr app)))) | |
109 | (when appmatch | |
110 | (setq match (cons app appmatch))))) | |
111 | match) | |
112 | ;; Other? | |
113 | )) | |
114 | ||
115 | (defmethod srecode-map-delete-file-entry ((map srecode-map) file) | |
116 | "Update MAP to exclude FILE from the file list." | |
117 | (let ((entry (srecode-map-entry-for-file map file))) | |
118 | (when entry | |
119 | (object-remove-from-list map 'files entry)))) | |
120 | ||
121 | (defmethod srecode-map-update-file-entry ((map srecode-map) file mode) | |
122 | "Update a MAP entry for FILE to be used with MODE. | |
123 | Return non-nil if the MAP was changed." | |
124 | (let ((entry (srecode-map-entry-for-file map file)) | |
125 | (dirty t)) | |
126 | (cond | |
127 | ;; It is already a match.. do nothing. | |
128 | ((and entry (eq (cdr entry) mode)) | |
129 | (setq dirty nil)) | |
130 | ;; We have a non-matching entry. Change the cdr. | |
131 | (entry | |
132 | (setcdr entry mode)) | |
133 | ;; No entry, just add it to the list. | |
134 | (t | |
135 | (object-add-to-list map 'files (cons file mode)) | |
136 | )) | |
137 | dirty)) | |
138 | ||
139 | (defmethod srecode-map-delete-file-entry-from-app ((map srecode-map) file app) | |
140 | "Delete from MAP the FILE entry within the APP'lication." | |
141 | (let* ((appe (srecode-map-entry-for-app map app)) | |
142 | (fentry (assoc file (cdr appe)))) | |
143 | (setcdr appe (delete fentry (cdr appe)))) | |
144 | ) | |
145 | ||
146 | (defmethod srecode-map-update-app-file-entry ((map srecode-map) file mode app) | |
147 | "Update the MAP entry for FILE to be used with MODE within APP. | |
148 | Return non-nil if the map was changed." | |
149 | (let* ((appentry (srecode-map-entry-for-app map app)) | |
150 | (appfileentry (assoc file (cdr appentry))) | |
151 | (dirty t) | |
152 | ) | |
153 | (cond | |
154 | ;; Option 1 - We have this file in this application already | |
155 | ;; with the correct mode. | |
156 | ((and appfileentry (eq (cdr appfileentry) mode)) | |
157 | (setq dirty nil) | |
158 | ) | |
159 | ;; Option 2 - We have a non-matching entry. Change Cdr. | |
160 | (appfileentry | |
161 | (setcdr appfileentry mode)) | |
162 | (t | |
163 | ;; For option 3 & 4 - remove the entry from any other lists | |
164 | ;; we can find. | |
165 | (let ((any (srecode-map-entry-for-file-anywhere map file))) | |
166 | (when any | |
167 | (if (null (car any)) | |
168 | ;; Global map entry | |
169 | (srecode-map-delete-file-entry map file) | |
170 | ;; Some app | |
171 | (let ((appentry (srecode-map-entry-for-app map app))) | |
172 | (setcdr appentry (delete (cdr any) (cdr appentry)))) | |
173 | ))) | |
174 | ;; Now do option 3 and 4 | |
175 | (cond | |
176 | ;; Option 3 - No entry for app. Add to the list. | |
177 | (appentry | |
178 | (setcdr appentry (cons (cons file mode) (cdr appentry))) | |
179 | ) | |
180 | ;; Option 4 - No app entry. Add app to list with this file. | |
181 | (t | |
182 | (object-add-to-list map 'apps (list app (cons file mode))) | |
183 | ))) | |
184 | ) | |
185 | dirty)) | |
186 | ||
187 | \f | |
188 | ;;; MAP Updating | |
189 | ;; | |
190 | ;;;###autoload | |
191 | (defun srecode-get-maps (&optional reset) | |
192 | "Get a list of maps relevant to the current buffer. | |
193 | Optional argument RESET forces a reset of the current map." | |
194 | (interactive "P") | |
195 | ;; Always update the map, but only do a full reset if | |
196 | ;; the user asks for one. | |
197 | (srecode-map-update-map (not reset)) | |
198 | ||
2054a44c | 199 | (if (called-interactively-p 'any) |
4d902e6f CY |
200 | ;; Dump this map. |
201 | (with-output-to-temp-buffer "*SRECODE MAP*" | |
202 | (princ " -- SRecode Global map --\n") | |
203 | (srecode-maps-dump-file-list (oref srecode-current-map files)) | |
204 | (princ "\n -- Application Maps --\n") | |
205 | (dolist (ap (oref srecode-current-map apps)) | |
206 | (let ((app (car ap)) | |
207 | (files (cdr ap))) | |
208 | (princ app) | |
209 | (princ " :\n") | |
210 | (srecode-maps-dump-file-list files)) | |
211 | (princ "\n")) | |
212 | (princ "\nUse:\n\n M-x customize-variable RET srecode-map-load-path RET") | |
213 | (princ "\n To change the path where SRecode loads templates from.") | |
214 | ) | |
215 | ;; Eventually, I want to return many maps to search through. | |
216 | (list srecode-current-map))) | |
217 | ||
218 | (eval-when-compile (require 'data-debug)) | |
219 | ||
220 | (defun srecode-adebug-maps () | |
221 | "Run ADEBUG on the output of `srecode-get-maps'." | |
222 | (interactive) | |
223 | (require 'data-debug) | |
224 | (let ((start (current-time)) | |
225 | (p (srecode-get-maps t)) ;; Time the reset. | |
226 | (end (current-time)) | |
227 | ) | |
228 | (message "Updating the map took %.2f seconds." | |
229 | (semantic-elapsed-time start end)) | |
230 | (data-debug-new-buffer "*SRECODE ADEBUG*") | |
231 | (data-debug-insert-stuff-list p "*"))) | |
232 | ||
233 | (defun srecode-maps-dump-file-list (flist) | |
234 | "Dump a file list FLIST to `standard-output'." | |
235 | (princ "Mode\t\t\tFilename\n") | |
236 | (princ "------\t\t\t------------------\n") | |
237 | (dolist (fe flist) | |
238 | (prin1 (cdr fe)) | |
239 | (princ "\t") | |
240 | (when (> (* 2 8) (length (symbol-name (cdr fe)))) | |
241 | (princ "\t")) | |
242 | (when (> 8 (length (symbol-name (cdr fe)))) | |
243 | (princ "\t")) | |
244 | (princ (car fe)) | |
245 | (princ "\n") | |
246 | )) | |
247 | ||
248 | (defun srecode-map-file-still-valid-p (filename map) | |
249 | "Return t if FILENAME should be in MAP still." | |
250 | (let ((valid nil)) | |
251 | (and (file-exists-p filename) | |
252 | (progn | |
253 | (dolist (p srecode-map-load-path) | |
254 | (when (and (< (length p) (length filename)) | |
255 | (string= p (substring filename 0 (length p)))) | |
256 | (setq valid t)) | |
257 | ) | |
258 | valid)) | |
259 | )) | |
260 | ||
261 | (defun srecode-map-update-map (&optional fast) | |
262 | "Update the current map from `srecode-map-load-path'. | |
263 | Scans all the files on the path, and makes sure we have entries | |
264 | for them. | |
265 | If option FAST is non-nil, then only parse a file for the mode-string | |
266 | if that file is NEW, otherwise assume the mode has not changed." | |
267 | (interactive) | |
268 | ||
269 | ;; When no map file, we are configured to not use a save file. | |
270 | (if (not srecode-map-save-file) | |
271 | ;; 0) Create a MAP when in no save file mode. | |
272 | (when (not srecode-current-map) | |
273 | (setq srecode-current-map (srecode-map "SRecode Map")) | |
274 | (message "SRecode map created in non-save mode.") | |
275 | ) | |
276 | ||
277 | ;; 1) Do we even have a MAP or save file? | |
278 | (when (and (not srecode-current-map) | |
279 | (not (file-exists-p srecode-map-save-file))) | |
280 | (when (not (file-exists-p (file-name-directory srecode-map-save-file))) | |
281 | ;; Only bother with this interactively, not during a build | |
282 | ;; or test. | |
283 | (when (not noninteractive) | |
284 | ;; No map, make the dir? | |
285 | (if (y-or-n-p (format "Create dir %s? " | |
286 | (file-name-directory srecode-map-save-file))) | |
287 | (make-directory (file-name-directory srecode-map-save-file)) | |
288 | ;; No make, change save file | |
289 | (customize-variable 'srecode-map-save-file) | |
290 | (error "Change your SRecode map file")))) | |
291 | ;; Have a dir. Make the object. | |
292 | (setq srecode-current-map | |
293 | (srecode-map "SRecode Map" | |
294 | :file srecode-map-save-file))) | |
295 | ||
296 | ;; 2) Do we not have a current map? If so load. | |
297 | (when (not srecode-current-map) | |
b9749554 EL |
298 | (condition-case nil |
299 | (setq srecode-current-map | |
300 | (eieio-persistent-read srecode-map-save-file)) | |
301 | (error | |
302 | ;; There was an error loading the old map. Create a new one. | |
303 | (setq srecode-current-map | |
304 | (srecode-map "SRecode Map" | |
305 | :file srecode-map-save-file)))) | |
4d902e6f CY |
306 | ) |
307 | ||
308 | ) | |
309 | ||
310 | ;; | |
311 | ;; We better have a MAP object now. | |
312 | ;; | |
313 | (let ((dirty nil)) | |
314 | ;; 3) - Purge dead files from the file list. | |
315 | (dolist (entry (copy-sequence (oref srecode-current-map files))) | |
316 | (when (not (srecode-map-file-still-valid-p | |
317 | (car entry) srecode-current-map)) | |
318 | (srecode-map-delete-file-entry srecode-current-map (car entry)) | |
319 | (setq dirty t) | |
320 | )) | |
321 | (dolist (app (copy-sequence (oref srecode-current-map apps))) | |
322 | (dolist (entry (copy-sequence (cdr app))) | |
323 | (when (not (srecode-map-file-still-valid-p | |
324 | (car entry) srecode-current-map)) | |
325 | (srecode-map-delete-file-entry-from-app | |
326 | srecode-current-map (car entry) (car app)) | |
327 | (setq dirty t) | |
328 | ))) | |
329 | ;; 4) - Find new files and add them to the map. | |
330 | (dolist (dir srecode-map-load-path) | |
331 | (when (file-exists-p dir) | |
332 | (dolist (f (directory-files dir t "\\.srt$")) | |
333 | (when (and (not (backup-file-name-p f)) | |
334 | (not (auto-save-file-name-p f)) | |
335 | (file-readable-p f)) | |
336 | (let ((fdirty (srecode-map-validate-file-for-mode f fast))) | |
337 | (setq dirty (or dirty fdirty)))) | |
338 | ))) | |
339 | ;; Only do the save if we are dirty, or if we are in an interactive | |
340 | ;; Emacs. | |
341 | (when (and dirty (not noninteractive) | |
342 | (slot-boundp srecode-current-map :file)) | |
343 | (eieio-persistent-save srecode-current-map)) | |
344 | )) | |
345 | ||
346 | (defun srecode-map-validate-file-for-mode (file fast) | |
347 | "Read and validate FILE via the parser. Return the mode. | |
348 | Argument FAST implies that the file should not be reparsed if there | |
349 | is already an entry for it. | |
350 | Return non-nil if the map changed." | |
351 | (when (or (not fast) | |
352 | (not (srecode-map-entry-for-file-anywhere srecode-current-map file))) | |
353 | (let ((buff-orig (get-file-buffer file)) | |
354 | (dirty nil)) | |
355 | (save-excursion | |
356 | (if buff-orig | |
357 | (set-buffer buff-orig) | |
358 | (set-buffer (get-buffer-create " *srecode-map-tmp*")) | |
359 | (insert-file-contents file nil nil nil t) | |
360 | ;; Force it to be ready to parse. | |
361 | (srecode-template-mode) | |
29e1a603 | 362 | (let ((semantic-init-hook nil)) |
4d902e6f CY |
363 | (semantic-new-buffer-fcn)) |
364 | ) | |
365 | ||
366 | (semantic-fetch-tags) | |
367 | (let* ((mode-tag | |
368 | (semantic-find-first-tag-by-name "mode" (current-buffer))) | |
369 | (val nil) | |
370 | (app-tag | |
371 | (semantic-find-first-tag-by-name "application" (current-buffer))) | |
372 | (app nil)) | |
373 | (if mode-tag | |
374 | (setq val (car (semantic-tag-variable-default mode-tag))) | |
375 | (error "There should be a mode declaration in %s" file)) | |
376 | (when app-tag | |
377 | (setq app (car (semantic-tag-variable-default app-tag)))) | |
378 | ||
379 | (setq dirty | |
380 | (if app | |
381 | (srecode-map-update-app-file-entry srecode-current-map | |
382 | file | |
383 | (read val) | |
384 | (read app)) | |
385 | (srecode-map-update-file-entry srecode-current-map | |
386 | file | |
387 | (read val)))) | |
388 | ) | |
389 | ) | |
390 | dirty))) | |
391 | ||
392 | \f | |
393 | ;;; THE PATH | |
394 | ;; | |
395 | ;; We need to do this last since the setter needs the above code. | |
396 | ||
397 | (defun srecode-map-load-path-set (sym val) | |
398 | "Set SYM to the new VAL, then update the srecode map." | |
399 | (set-default sym val) | |
400 | (srecode-map-update-map t)) | |
401 | ||
402 | (defcustom srecode-map-load-path | |
403 | (list (srecode-map-base-template-dir) | |
404 | (expand-file-name "~/.srecode/") | |
405 | ) | |
e6e267fc | 406 | "Global load path for SRecode template files." |
4d902e6f CY |
407 | :group 'srecode |
408 | :type '(repeat file) | |
409 | :set 'srecode-map-load-path-set) | |
410 | ||
411 | (provide 'srecode/map) | |
412 | ||
413 | ;; Local variables: | |
414 | ;; generated-autoload-file: "loaddefs.el" | |
4d902e6f CY |
415 | ;; generated-autoload-load-name: "srecode/map" |
416 | ;; End: | |
417 | ||
418 | ;;; srecode/map.el ends here |