Commit | Line | Data |
---|---|---|
acc33231 CY |
1 | ;;; ede/linux.el --- Special project for Linux |
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 Linux, cause Linux is special. | |
25 | ;; | |
26 | ;; Identifies a Linux 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) | |
62a81506 CY |
36 | (require 'ede/make) |
37 | ||
acc33231 CY |
38 | (declare-function semanticdb-file-table-object "semantic/db") |
39 | (declare-function semanticdb-needs-refresh-p "semantic/db") | |
40 | (declare-function semanticdb-refresh-table "semantic/db") | |
41 | ||
42 | ;;; Code: | |
62a81506 CY |
43 | (defgroup project-linux nil |
44 | "File and tag browser frame." | |
45 | :group 'tools | |
46 | :group 'ede | |
47 | ) | |
48 | ||
49 | (defcustom project-linux-compile-target-command (concat ede-make-command " -k -C %s SUBDIRS=%s") | |
50 | "*Default command used to compile a target." | |
51 | :group 'project-linux | |
52 | :type 'string) | |
53 | ||
54 | (defcustom project-linux-compile-project-command (concat ede-make-command " -k -C %s") | |
55 | "*Default command used to compile a project." | |
56 | :group 'project-linux | |
57 | :type 'string) | |
58 | ||
acc33231 CY |
59 | (defvar ede-linux-project-list nil |
60 | "List of projects created by option `ede-linux-project'.") | |
61 | ||
62 | (defun ede-linux-file-existing (dir) | |
63 | "Find a Linux project in the list of Linux projects. | |
64 | DIR is the directory to search from." | |
65 | (let ((projs ede-linux-project-list) | |
66 | (ans nil)) | |
67 | (while (and projs (not ans)) | |
68 | (let ((root (ede-project-root-directory (car projs)))) | |
69 | (when (string-match (concat "^" (regexp-quote root)) dir) | |
70 | (setq ans (car projs)))) | |
71 | (setq projs (cdr projs))) | |
72 | ans)) | |
73 | ||
74 | ;;;###autoload | |
75 | (defun ede-linux-project-root (&optional dir) | |
76 | "Get the root directory for DIR." | |
77 | (when (not dir) (setq dir default-directory)) | |
78 | (let ((case-fold-search t) | |
79 | (proj (ede-linux-file-existing dir))) | |
80 | (if proj | |
81 | (ede-up-directory (file-name-directory | |
82 | (oref proj :file))) | |
c7015153 | 83 | ;; No pre-existing project. Let's take a wild-guess if we have |
acc33231 CY |
84 | ;; an Linux project here. |
85 | (when (string-match "linux[^/]*" dir) | |
86 | (let ((base (substring dir 0 (match-end 0)))) | |
87 | (when (file-exists-p (expand-file-name "scripts/ver_linux" base)) | |
88 | base)))))) | |
89 | ||
90 | (defun ede-linux-version (dir) | |
91 | "Find the Linux version for the Linux src in DIR." | |
92 | (let ((buff (get-buffer-create " *linux-query*"))) | |
0816d744 | 93 | (with-current-buffer buff |
acc33231 CY |
94 | (erase-buffer) |
95 | (setq default-directory (file-name-as-directory dir)) | |
67d3ffe4 | 96 | (insert-file-contents "Makefile" nil 0 512) |
acc33231 CY |
97 | (goto-char (point-min)) |
98 | (let (major minor sub) | |
99 | (re-search-forward "^VERSION *= *\\([0-9.]+\\)") | |
100 | (setq major (match-string 1)) | |
101 | (re-search-forward "^PATCHLEVEL *= *\\([0-9.]+\\)") | |
102 | (setq minor (match-string 1)) | |
103 | (re-search-forward "^SUBLEVEL *= *\\([0-9.]+\\)") | |
104 | (setq sub (match-string 1)) | |
105 | (prog1 | |
106 | (concat major "." minor "." sub) | |
107 | (kill-buffer buff) | |
108 | ))))) | |
109 | ||
110 | (defclass ede-linux-project (ede-project eieio-instance-tracker) | |
111 | ((tracking-symbol :initform 'ede-linux-project-list) | |
112 | ) | |
113 | "Project Type for the Linux source code." | |
114 | :method-invocation-order :depth-first) | |
115 | ||
62a81506 | 116 | ;;;###autoload |
acc33231 CY |
117 | (defun ede-linux-load (dir &optional rootproj) |
118 | "Return an Linux Project object if there is a match. | |
119 | Return nil if there isn't one. | |
120 | Argument DIR is the directory it is created for. | |
121 | ROOTPROJ is nil, since there is only one project." | |
122 | (or (ede-linux-file-existing dir) | |
c7015153 | 123 | ;; Doesn't already exist, so let's make one. |
62a81506 CY |
124 | (let ((proj (ede-linux-project |
125 | "Linux" | |
126 | :name "Linux" | |
127 | :version (ede-linux-version dir) | |
128 | :directory (file-name-as-directory dir) | |
129 | :file (expand-file-name "scripts/ver_linux" | |
130 | dir)))) | |
131 | (ede-add-project-to-global-list proj)) | |
132 | )) | |
acc33231 | 133 | |
cb85c0d8 | 134 | ;;;###autoload |
62a81506 CY |
135 | (ede-add-project-autoload |
136 | (ede-project-autoload "linux" | |
137 | :name "LINUX ROOT" | |
138 | :file 'ede/linux | |
139 | :proj-file "scripts/ver_linux" | |
140 | :proj-root-dirmatch "linux[^/]*" | |
141 | :proj-root 'ede-linux-project-root | |
142 | :load-type 'ede-linux-load | |
143 | :class-sym 'ede-linux-project | |
144 | :new-p nil | |
145 | :safe-p t) | |
146 | 'unique) | |
cb85c0d8 | 147 | |
acc33231 CY |
148 | (defclass ede-linux-target-c (ede-target) |
149 | () | |
150 | "EDE Linux Project target for C code. | |
151 | All directories need at least one target.") | |
152 | ||
153 | (defclass ede-linux-target-misc (ede-target) | |
154 | () | |
155 | "EDE Linux Project target for Misc files. | |
156 | All directories need at least one target.") | |
157 | ||
158 | (defmethod initialize-instance ((this ede-linux-project) | |
159 | &rest fields) | |
cb85c0d8 | 160 | "Make sure the targets slot is bound." |
acc33231 CY |
161 | (call-next-method) |
162 | (unless (slot-boundp this 'targets) | |
163 | (oset this :targets nil))) | |
164 | ||
165 | ;;; File Stuff | |
166 | ;; | |
167 | (defmethod ede-project-root-directory ((this ede-linux-project) | |
168 | &optional file) | |
169 | "Return the root for THIS Linux project with file." | |
170 | (ede-up-directory (file-name-directory (oref this file)))) | |
171 | ||
172 | (defmethod ede-project-root ((this ede-linux-project)) | |
173 | "Return my root." | |
174 | this) | |
175 | ||
176 | (defmethod ede-find-subproject-for-directory ((proj ede-linux-project) | |
177 | dir) | |
178 | "Return PROJ, for handling all subdirs below DIR." | |
179 | proj) | |
180 | ||
181 | ;;; TARGET MANAGEMENT | |
182 | ;; | |
183 | (defun ede-linux-find-matching-target (class dir targets) | |
184 | "Find a target that is a CLASS and is in DIR in the list of TARGETS." | |
185 | (let ((match nil)) | |
186 | (dolist (T targets) | |
187 | (when (and (object-of-class-p T class) | |
188 | (string= (oref T :path) dir)) | |
189 | (setq match T) | |
190 | )) | |
191 | match)) | |
192 | ||
193 | (defmethod ede-find-target ((proj ede-linux-project) buffer) | |
194 | "Find an EDE target in PROJ for BUFFER. | |
195 | If one doesn't exist, create a new one for this directory." | |
196 | (let* ((ext (file-name-extension (buffer-file-name buffer))) | |
197 | (cls (cond ((not ext) | |
198 | 'ede-linux-target-misc) | |
199 | ((string-match "c\\|h" ext) | |
200 | 'ede-linux-target-c) | |
201 | (t 'ede-linux-target-misc))) | |
202 | (targets (oref proj targets)) | |
203 | (dir default-directory) | |
204 | (ans (ede-linux-find-matching-target cls dir targets)) | |
205 | ) | |
206 | (when (not ans) | |
207 | (setq ans (make-instance | |
208 | cls | |
209 | :name (file-name-nondirectory | |
210 | (directory-file-name dir)) | |
211 | :path dir | |
212 | :source nil)) | |
213 | (object-add-to-list proj :targets ans) | |
214 | ) | |
215 | ans)) | |
216 | ||
217 | ;;; UTILITIES SUPPORT. | |
218 | ;; | |
219 | (defmethod ede-preprocessor-map ((this ede-linux-target-c)) | |
220 | "Get the pre-processor map for Linux C code. | |
221 | All files need the macros from lisp.h!" | |
222 | (require 'semantic/db) | |
223 | (let* ((proj (ede-target-parent this)) | |
224 | (root (ede-project-root proj)) | |
225 | (versionfile (ede-expand-filename root "include/linux/version.h")) | |
226 | (table (when (and versionfile (file-exists-p versionfile)) | |
227 | (semanticdb-file-table-object versionfile))) | |
228 | (filemap '( ("__KERNEL__" . "") | |
229 | )) | |
230 | ) | |
231 | (when table | |
232 | (when (semanticdb-needs-refresh-p table) | |
233 | (semanticdb-refresh-table table)) | |
234 | (setq filemap (append filemap (oref table lexical-table))) | |
235 | ) | |
236 | filemap | |
237 | )) | |
238 | ||
239 | (defun ede-linux-file-exists-name (name root subdir) | |
240 | "Return a file name if NAME exists under ROOT with SUBDIR in between." | |
241 | (let ((F (expand-file-name name (expand-file-name subdir root)))) | |
242 | (when (file-exists-p F) F))) | |
243 | ||
244 | (defmethod ede-expand-filename-impl ((proj ede-linux-project) name) | |
245 | "Within this project PROJ, find the file NAME. | |
246 | Knows about how the Linux source tree is organized." | |
247 | (let* ((ext (file-name-extension name)) | |
248 | (root (ede-project-root proj)) | |
249 | (dir (ede-project-root-directory root)) | |
250 | (F (cond | |
251 | ((not ext) nil) | |
252 | ((string-match "h" ext) | |
253 | (or (ede-linux-file-exists-name name dir "") | |
254 | (ede-linux-file-exists-name name dir "include")) | |
255 | ) | |
256 | ((string-match "txt" ext) | |
257 | (ede-linux-file-exists-name name dir "Documentation")) | |
258 | (t nil))) | |
259 | ) | |
260 | (or F (call-next-method)))) | |
261 | ||
62a81506 CY |
262 | (defmethod project-compile-project ((proj ede-linux-project) |
263 | &optional command) | |
264 | "Compile the entire current project. | |
265 | Argument COMMAND is the command to use when compiling." | |
266 | (let* ((dir (ede-project-root-directory proj))) | |
267 | ||
268 | (require 'compile) | |
269 | (if (not project-linux-compile-project-command) | |
270 | (setq project-linux-compile-project-command compile-command)) | |
271 | (if (not command) | |
272 | (setq command | |
273 | (format | |
274 | project-linux-compile-project-command | |
275 | dir))) | |
276 | ||
277 | (compile command))) | |
278 | ||
279 | (defmethod project-compile-target ((obj ede-linux-target-c) &optional command) | |
280 | "Compile the current target. | |
281 | Argument COMMAND is the command to use for compiling the target." | |
282 | (let* ((proj (ede-target-parent obj)) | |
283 | (root (ede-project-root proj)) | |
284 | (dir (ede-project-root-directory root)) | |
285 | (subdir (oref obj path))) | |
286 | ||
287 | (require 'compile) | |
288 | (if (not project-linux-compile-project-command) | |
289 | (setq project-linux-compile-project-command compile-command)) | |
290 | (if (not command) | |
291 | (setq command | |
292 | (format | |
293 | project-linux-compile-target-command | |
294 | dir subdir))) | |
295 | ||
296 | (compile command))) | |
297 | ||
acc33231 CY |
298 | (provide 'ede/linux) |
299 | ||
300 | ;; Local variables: | |
301 | ;; generated-autoload-file: "loaddefs.el" | |
acc33231 CY |
302 | ;; generated-autoload-load-name: "ede/linux" |
303 | ;; End: | |
304 | ||
305 | ;;; ede/linux.el ends here |