Mercurial > emacs
annotate lisp/cedet/srecode/map.el @ 108712:056a00ed4b81
Use terminfo rather than termcap on recent NetBSD.
* configure.in: On NetBSD, if terminfo is found, use it in preference
to termcap. (Bug#6190)
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Wed, 19 May 2010 23:37:29 -0700 |
parents | 1d1d5d9bd884 |
children | 67ff8ad45bd5 |
rev | line source |
---|---|
104498 | 1 ;;; srecode/map.el --- Manage a template file map |
2 | |
106815 | 3 ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc. |
104498 | 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." | |
105406
5b8c8cd21526
* cedet/srecode/srt-mode.el (srecode-template-mode): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
105377
diff
changeset
|
39 (expand-file-name "srecode" data-directory)) |
104498 | 40 |
41 ;;; Current MAP | |
42 ;; | |
43 | |
44 (defvar srecode-current-map nil | |
105328 | 45 "The current map for global SRecode templates.") |
104498 | 46 |
105410
38782a5dda5e
* cedet/srecode/map.el (srecode-map-save-file): Default to a file in
Chong Yidong <cyd@stupidchicken.com>
parents:
105406
diff
changeset
|
47 (defcustom srecode-map-save-file |
105418
0f5992576338
* cedet/semantic/db-file.el (semanticdb-default-save-directory):
Chong Yidong <cyd@stupidchicken.com>
parents:
105413
diff
changeset
|
48 (locate-user-emacs-file "srecode-map.el" ".srecode/srecode-map") |
104498 | 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 | |
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 | |
106197
019d906c8f48
* cedet/srecode/map.el (srecode-get-maps):
Chong Yidong <cyd@stupidchicken.com>
parents:
105842
diff
changeset
|
199 (if (called-interactively-p 'any) |
104498 | 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) | |
298 (setq srecode-current-map | |
299 (eieio-persistent-read srecode-map-save-file)) | |
300 ) | |
301 | |
302 ) | |
303 | |
304 ;; | |
305 ;; We better have a MAP object now. | |
306 ;; | |
307 (let ((dirty nil)) | |
308 ;; 3) - Purge dead files from the file list. | |
309 (dolist (entry (copy-sequence (oref srecode-current-map files))) | |
310 (when (not (srecode-map-file-still-valid-p | |
311 (car entry) srecode-current-map)) | |
312 (srecode-map-delete-file-entry srecode-current-map (car entry)) | |
313 (setq dirty t) | |
314 )) | |
315 (dolist (app (copy-sequence (oref srecode-current-map apps))) | |
316 (dolist (entry (copy-sequence (cdr app))) | |
317 (when (not (srecode-map-file-still-valid-p | |
318 (car entry) srecode-current-map)) | |
319 (srecode-map-delete-file-entry-from-app | |
320 srecode-current-map (car entry) (car app)) | |
321 (setq dirty t) | |
322 ))) | |
323 ;; 4) - Find new files and add them to the map. | |
324 (dolist (dir srecode-map-load-path) | |
325 (when (file-exists-p dir) | |
326 (dolist (f (directory-files dir t "\\.srt$")) | |
327 (when (and (not (backup-file-name-p f)) | |
328 (not (auto-save-file-name-p f)) | |
329 (file-readable-p f)) | |
330 (let ((fdirty (srecode-map-validate-file-for-mode f fast))) | |
331 (setq dirty (or dirty fdirty)))) | |
332 ))) | |
333 ;; Only do the save if we are dirty, or if we are in an interactive | |
334 ;; Emacs. | |
335 (when (and dirty (not noninteractive) | |
336 (slot-boundp srecode-current-map :file)) | |
337 (eieio-persistent-save srecode-current-map)) | |
338 )) | |
339 | |
340 (defun srecode-map-validate-file-for-mode (file fast) | |
341 "Read and validate FILE via the parser. Return the mode. | |
342 Argument FAST implies that the file should not be reparsed if there | |
343 is already an entry for it. | |
344 Return non-nil if the map changed." | |
345 (when (or (not fast) | |
346 (not (srecode-map-entry-for-file-anywhere srecode-current-map file))) | |
347 (let ((buff-orig (get-file-buffer file)) | |
348 (dirty nil)) | |
349 (save-excursion | |
350 (if buff-orig | |
351 (set-buffer buff-orig) | |
352 (set-buffer (get-buffer-create " *srecode-map-tmp*")) | |
353 (insert-file-contents file nil nil nil t) | |
354 ;; Force it to be ready to parse. | |
355 (srecode-template-mode) | |
104513
a6a812dd2d88
* cedet/semantic/lex.el (semantic-lex-reset-hooks): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
104498
diff
changeset
|
356 (let ((semantic-init-hook nil)) |
104498 | 357 (semantic-new-buffer-fcn)) |
358 ) | |
359 | |
360 (semantic-fetch-tags) | |
361 (let* ((mode-tag | |
362 (semantic-find-first-tag-by-name "mode" (current-buffer))) | |
363 (val nil) | |
364 (app-tag | |
365 (semantic-find-first-tag-by-name "application" (current-buffer))) | |
366 (app nil)) | |
367 (if mode-tag | |
368 (setq val (car (semantic-tag-variable-default mode-tag))) | |
369 (error "There should be a mode declaration in %s" file)) | |
370 (when app-tag | |
371 (setq app (car (semantic-tag-variable-default app-tag)))) | |
372 | |
373 (setq dirty | |
374 (if app | |
375 (srecode-map-update-app-file-entry srecode-current-map | |
376 file | |
377 (read val) | |
378 (read app)) | |
379 (srecode-map-update-file-entry srecode-current-map | |
380 file | |
381 (read val)))) | |
382 ) | |
383 ) | |
384 dirty))) | |
385 | |
386 | |
387 ;;; THE PATH | |
388 ;; | |
389 ;; We need to do this last since the setter needs the above code. | |
390 | |
391 (defun srecode-map-load-path-set (sym val) | |
392 "Set SYM to the new VAL, then update the srecode map." | |
393 (set-default sym val) | |
394 (srecode-map-update-map t)) | |
395 | |
396 (defcustom srecode-map-load-path | |
397 (list (srecode-map-base-template-dir) | |
398 (expand-file-name "~/.srecode/") | |
399 ) | |
105406
5b8c8cd21526
* cedet/srecode/srt-mode.el (srecode-template-mode): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
105377
diff
changeset
|
400 "Global load path for SRecode template files." |
104498 | 401 :group 'srecode |
402 :type '(repeat file) | |
403 :set 'srecode-map-load-path-set) | |
404 | |
405 (provide 'srecode/map) | |
406 | |
407 ;; Local variables: | |
408 ;; generated-autoload-file: "loaddefs.el" | |
409 ;; generated-autoload-load-name: "srecode/map" | |
410 ;; End: | |
411 | |
105377 | 412 ;; arch-tag: dc90c737-1e87-455a-bbd1-6b72cdbfb7fd |
104498 | 413 ;;; srecode/map.el ends here |