Commit | Line | Data |
---|---|---|
acc33231 CY |
1 | ;;; ede/emacs.el --- Special project for Emacs |
2 | ||
acaf905b | 3 | ;; Copyright (C) 2008-2012 Free Software Foundation, Inc. |
acc33231 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 | ;; Provide a special project type just for Emacs, cause Emacs is special. | |
25 | ;; | |
26 | ;; Identifies an Emacs project automatically. | |
27 | ;; Speedy ede-expand-filename based on extension. | |
28 | ;; Pre-populates the preprocessor map from lisp.h | |
29 | ;; | |
30 | ;; ToDo : | |
31 | ;; * Add "build" options. | |
32 | ;; * Add texinfo lookup options. | |
33 | ;; * Add website | |
34 | ||
35 | (require 'ede) | |
36 | (declare-function semanticdb-file-table-object "semantic/db") | |
37 | (declare-function semanticdb-needs-refresh-p "semantic/db") | |
38 | (declare-function semanticdb-refresh-table "semantic/db") | |
39 | ||
40 | ;;; Code: | |
41 | (defvar ede-emacs-project-list nil | |
42 | "List of projects created by option `ede-emacs-project'.") | |
43 | ||
44 | (defun ede-emacs-file-existing (dir) | |
45 | "Find a Emacs project in the list of Emacs projects. | |
46 | DIR is the directory to search from." | |
47 | (let ((projs ede-emacs-project-list) | |
48 | (ans nil)) | |
49 | (while (and projs (not ans)) | |
50 | (let ((root (ede-project-root-directory (car projs)))) | |
67d3ffe4 CY |
51 | (when (string-match (concat "^" (regexp-quote root)) |
52 | (file-name-as-directory dir)) | |
acc33231 CY |
53 | (setq ans (car projs)))) |
54 | (setq projs (cdr projs))) | |
55 | ans)) | |
56 | ||
57 | ;;;###autoload | |
58 | (defun ede-emacs-project-root (&optional dir) | |
59 | "Get the root directory for DIR." | |
60 | (when (not dir) (setq dir default-directory)) | |
61 | (let ((case-fold-search t) | |
62 | (proj (ede-emacs-file-existing dir))) | |
63 | (if proj | |
64 | (ede-up-directory (file-name-directory | |
65 | (oref proj :file))) | |
c7015153 | 66 | ;; No pre-existing project. Let's take a wild-guess if we have |
acc33231 CY |
67 | ;; an Emacs project here. |
68 | (when (string-match "emacs[^/]*" dir) | |
69 | (let ((base (substring dir 0 (match-end 0)))) | |
70 | (when (file-exists-p (expand-file-name "src/emacs.c" base)) | |
71 | base)))))) | |
72 | ||
73 | (defun ede-emacs-version (dir) | |
67d3ffe4 CY |
74 | "Find the Emacs version for the Emacs src in DIR. |
75 | Return a tuple of ( EMACSNAME . VERSION )." | |
76 | (let ((buff (get-buffer-create " *emacs-query*")) | |
c4444d16 | 77 | (configure_ac "configure.ac") |
67d3ffe4 CY |
78 | (emacs "Emacs") |
79 | (ver "")) | |
0816d744 | 80 | (with-current-buffer buff |
acc33231 CY |
81 | (erase-buffer) |
82 | (setq default-directory (file-name-as-directory dir)) | |
c4444d16 PE |
83 | (or (file-exists-p configure_ac) |
84 | (setq configure_ac "configure.in")) | |
67d3ffe4 | 85 | ;(call-process "egrep" nil buff nil "-n" "-e" "^version=" "Makefile") |
c4444d16 | 86 | (call-process "egrep" nil buff nil "-n" "-e" "AC_INIT" configure_ac) |
acc33231 | 87 | (goto-char (point-min)) |
67d3ffe4 CY |
88 | ;(re-search-forward "version=\\([0-9.]+\\)") |
89 | (cond | |
90 | ;; Maybe XEmacs? | |
91 | ((file-exists-p "version.sh") | |
92 | (setq emacs "XEmacs") | |
93 | (insert-file-contents "version.sh") | |
94 | (goto-char (point-min)) | |
95 | (re-search-forward "emacs_major_version=\\([0-9]+\\) | |
96 | emacs_minor_version=\\([0-9]+\\) | |
97 | emacs_beta_version=\\([0-9]+\\)") | |
98 | (setq ver (concat (match-string 1) "." | |
99 | (match-string 2) "." | |
100 | (match-string 3))) | |
101 | ) | |
62a81506 CY |
102 | ((file-exists-p "sxemacs.pc.in") |
103 | (setq emacs "SXEmacs") | |
104 | (insert-file-contents "sxemacs_version.m4") | |
105 | (goto-char (point-min)) | |
106 | (re-search-forward "m4_define(\\[SXEM4CS_MAJOR_VERSION\\], \\[\\([0-9]+\\)\\]) | |
107 | m4_define(\\[SXEM4CS_MINOR_VERSION\\], \\[\\([0-9]+\\)\\]) | |
108 | m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])") | |
109 | (setq ver (concat (match-string 1) "." | |
110 | (match-string 2) "." | |
111 | (match-string 3))) | |
112 | ) | |
67d3ffe4 CY |
113 | ;; Insert other Emacs here... |
114 | ||
115 | ;; Vaguely recent version of GNU Emacs? | |
116 | (t | |
c4444d16 | 117 | (insert-file-contents configure_ac) |
67d3ffe4 CY |
118 | (goto-char (point-min)) |
119 | (re-search-forward "AC_INIT(emacs,\\s-*\\([0-9.]+\\)\\s-*)") | |
120 | (setq ver (match-string 1)) | |
121 | ) | |
122 | ) | |
123 | ;; Return a tuple | |
124 | (cons emacs ver)))) | |
acc33231 CY |
125 | |
126 | (defclass ede-emacs-project (ede-project eieio-instance-tracker) | |
127 | ((tracking-symbol :initform 'ede-emacs-project-list) | |
128 | ) | |
129 | "Project Type for the Emacs source code." | |
130 | :method-invocation-order :depth-first) | |
131 | ||
132 | (defun ede-emacs-load (dir &optional rootproj) | |
133 | "Return an Emacs Project object if there is a match. | |
134 | Return nil if there isn't one. | |
135 | Argument DIR is the directory it is created for. | |
136 | ROOTPROJ is nil, since there is only one project." | |
137 | (or (ede-emacs-file-existing dir) | |
c7015153 | 138 | ;; Doesn't already exist, so let's make one. |
62a81506 CY |
139 | (let* ((vertuple (ede-emacs-version dir)) |
140 | (proj (ede-emacs-project | |
141 | (car vertuple) | |
142 | :name (car vertuple) | |
143 | :version (cdr vertuple) | |
144 | :directory (file-name-as-directory dir) | |
145 | :file (expand-file-name "src/emacs.c" | |
146 | dir)))) | |
147 | (ede-add-project-to-global-list proj)))) | |
acc33231 | 148 | |
cb85c0d8 | 149 | ;;;###autoload |
62a81506 CY |
150 | (ede-add-project-autoload |
151 | (ede-project-autoload "emacs" | |
152 | :name "EMACS ROOT" | |
153 | :file 'ede/emacs | |
154 | :proj-file "src/emacs.c" | |
155 | :proj-root-dirmatch "emacs[^/]*" | |
156 | :proj-root 'ede-emacs-project-root | |
157 | :load-type 'ede-emacs-load | |
158 | :class-sym 'ede-emacs-project | |
159 | :new-p nil | |
160 | :safe-p t) | |
161 | 'unique) | |
cb85c0d8 | 162 | |
acc33231 CY |
163 | (defclass ede-emacs-target-c (ede-target) |
164 | () | |
165 | "EDE Emacs Project target for C code. | |
166 | All directories need at least one target.") | |
167 | ||
168 | (defclass ede-emacs-target-el (ede-target) | |
169 | () | |
170 | "EDE Emacs Project target for Emacs Lisp code. | |
171 | All directories need at least one target.") | |
172 | ||
173 | (defclass ede-emacs-target-misc (ede-target) | |
174 | () | |
175 | "EDE Emacs Project target for Misc files. | |
176 | All directories need at least one target.") | |
177 | ||
178 | (defmethod initialize-instance ((this ede-emacs-project) | |
179 | &rest fields) | |
cb85c0d8 | 180 | "Make sure the targets slot is bound." |
acc33231 CY |
181 | (call-next-method) |
182 | (unless (slot-boundp this 'targets) | |
183 | (oset this :targets nil))) | |
184 | ||
185 | ;;; File Stuff | |
186 | ;; | |
187 | (defmethod ede-project-root-directory ((this ede-emacs-project) | |
188 | &optional file) | |
189 | "Return the root for THIS Emacs project with file." | |
190 | (ede-up-directory (file-name-directory (oref this file)))) | |
191 | ||
192 | (defmethod ede-project-root ((this ede-emacs-project)) | |
193 | "Return my root." | |
194 | this) | |
195 | ||
196 | (defmethod ede-find-subproject-for-directory ((proj ede-emacs-project) | |
197 | dir) | |
198 | "Return PROJ, for handling all subdirs below DIR." | |
199 | proj) | |
200 | ||
201 | ;;; TARGET MANAGEMENT | |
202 | ;; | |
203 | (defun ede-emacs-find-matching-target (class dir targets) | |
204 | "Find a target that is a CLASS and is in DIR in the list of TARGETS." | |
205 | (let ((match nil)) | |
206 | (dolist (T targets) | |
207 | (when (and (object-of-class-p T class) | |
208 | (string= (oref T :path) dir)) | |
209 | (setq match T) | |
210 | )) | |
211 | match)) | |
212 | ||
213 | (defmethod ede-find-target ((proj ede-emacs-project) buffer) | |
214 | "Find an EDE target in PROJ for BUFFER. | |
215 | If one doesn't exist, create a new one for this directory." | |
216 | (let* ((ext (file-name-extension (buffer-file-name buffer))) | |
217 | (cls (cond ((not ext) | |
218 | 'ede-emacs-target-misc) | |
219 | ((string-match "c\\|h" ext) | |
220 | 'ede-emacs-target-c) | |
221 | ((string-match "elc?" ext) | |
222 | 'ede-emacs-target-el) | |
223 | (t 'ede-emacs-target-misc))) | |
224 | (targets (oref proj targets)) | |
225 | (dir default-directory) | |
226 | (ans (ede-emacs-find-matching-target cls dir targets)) | |
227 | ) | |
228 | (when (not ans) | |
229 | (setq ans (make-instance | |
230 | cls | |
231 | :name (file-name-nondirectory | |
232 | (directory-file-name dir)) | |
233 | :path dir | |
234 | :source nil)) | |
235 | (object-add-to-list proj :targets ans) | |
236 | ) | |
237 | ans)) | |
238 | ||
239 | ;;; UTILITIES SUPPORT. | |
240 | ;; | |
241 | (defmethod ede-preprocessor-map ((this ede-emacs-target-c)) | |
242 | "Get the pre-processor map for Emacs C code. | |
243 | All files need the macros from lisp.h!" | |
244 | (require 'semantic/db) | |
245 | (let* ((proj (ede-target-parent this)) | |
246 | (root (ede-project-root proj)) | |
247 | (table (semanticdb-file-table-object | |
248 | (ede-expand-filename root "lisp.h"))) | |
1dc5c6f3 CY |
249 | (config (semanticdb-file-table-object |
250 | (ede-expand-filename root "config.h"))) | |
acc33231 CY |
251 | filemap |
252 | ) | |
253 | (when table | |
254 | (when (semanticdb-needs-refresh-p table) | |
255 | (semanticdb-refresh-table table)) | |
256 | (setq filemap (append filemap (oref table lexical-table))) | |
257 | ) | |
1dc5c6f3 CY |
258 | (when config |
259 | (when (semanticdb-needs-refresh-p config) | |
260 | (semanticdb-refresh-table config)) | |
261 | (setq filemap (append filemap (oref config lexical-table))) | |
262 | ) | |
acc33231 CY |
263 | filemap |
264 | )) | |
265 | ||
266 | (defun ede-emacs-find-in-directories (name base dirs) | |
267 | "Find NAME is BASE directory sublist of DIRS." | |
268 | (let ((ans nil)) | |
269 | (while (and dirs (not ans)) | |
270 | (let* ((D (car dirs)) | |
271 | (ed (expand-file-name D base)) | |
272 | (ef (expand-file-name name ed))) | |
273 | (if (file-exists-p ef) | |
274 | (setq ans ef) | |
275 | ;; Not in this dir? How about subdirs? | |
276 | (let ((dirfile (directory-files ed t)) | |
277 | (moredirs nil) | |
278 | ) | |
279 | ;; Get all the subdirs. | |
280 | (dolist (DF dirfile) | |
281 | (when (and (file-directory-p DF) | |
282 | (not (string-match "\\.$" DF))) | |
283 | (push DF moredirs))) | |
284 | ;; Try again. | |
285 | (setq ans (ede-emacs-find-in-directories name ed moredirs)) | |
286 | )) | |
287 | (setq dirs (cdr dirs)))) | |
288 | ans)) | |
289 | ||
290 | (defmethod ede-expand-filename-impl ((proj ede-emacs-project) name) | |
291 | "Within this project PROJ, find the file NAME. | |
292 | Knows about how the Emacs source tree is organized." | |
293 | (let* ((ext (file-name-extension name)) | |
294 | (root (ede-project-root proj)) | |
295 | (dir (ede-project-root-directory root)) | |
296 | (dirs (cond | |
297 | ((not ext) nil) | |
298 | ((string-match "h\\|c" ext) | |
299 | '("src" "lib-src" "lwlib")) | |
300 | ((string-match "elc?" ext) | |
301 | '("lisp")) | |
302 | ((string-match "texi" ext) | |
303 | '("doc")) | |
304 | (t nil))) | |
305 | ) | |
306 | (if (not dirs) (call-next-method) | |
307 | (ede-emacs-find-in-directories name dir dirs)) | |
308 | )) | |
309 | ||
310 | (provide 'ede/emacs) | |
311 | ||
312 | ;; Local variables: | |
313 | ;; generated-autoload-file: "loaddefs.el" | |
acc33231 CY |
314 | ;; generated-autoload-load-name: "ede/emacs" |
315 | ;; End: | |
316 | ||
317 | ;;; ede/emacs.el ends here |