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