Mercurial > emacs
comparison lisp/cedet/ede/linux.el @ 104496:8c4870c15962
* cedet/ede.el, cedet/ede/*.el: New files.
* cedet/cedet.el: Require ede.
* cedet/semantic/symref/filter.el (semantic-symref-hits-in-region):
Require semantic/idle.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Sun, 20 Sep 2009 15:06:05 +0000 |
parents | |
children | 7f4c7f5c0eba |
comparison
equal
deleted
inserted
replaced
104495:4659ddbe20bf | 104496:8c4870c15962 |
---|---|
1 ;;; ede/linux.el --- Special project for Linux | |
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 ;; 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) | |
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-linux-project-list nil | |
42 "List of projects created by option `ede-linux-project'.") | |
43 | |
44 (defun ede-linux-file-existing (dir) | |
45 "Find a Linux project in the list of Linux projects. | |
46 DIR is the directory to search from." | |
47 (let ((projs ede-linux-project-list) | |
48 (ans nil)) | |
49 (while (and projs (not ans)) | |
50 (let ((root (ede-project-root-directory (car projs)))) | |
51 (when (string-match (concat "^" (regexp-quote root)) dir) | |
52 (setq ans (car projs)))) | |
53 (setq projs (cdr projs))) | |
54 ans)) | |
55 | |
56 ;;;###autoload | |
57 (defun ede-linux-project-root (&optional dir) | |
58 "Get the root directory for DIR." | |
59 (when (not dir) (setq dir default-directory)) | |
60 (let ((case-fold-search t) | |
61 (proj (ede-linux-file-existing dir))) | |
62 (if proj | |
63 (ede-up-directory (file-name-directory | |
64 (oref proj :file))) | |
65 ;; No pre-existing project. Lets take a wild-guess if we have | |
66 ;; an Linux project here. | |
67 (when (string-match "linux[^/]*" dir) | |
68 (let ((base (substring dir 0 (match-end 0)))) | |
69 (when (file-exists-p (expand-file-name "scripts/ver_linux" base)) | |
70 base)))))) | |
71 | |
72 (defun ede-linux-version (dir) | |
73 "Find the Linux version for the Linux src in DIR." | |
74 (let ((buff (get-buffer-create " *linux-query*"))) | |
75 (save-excursion | |
76 (set-buffer buff) | |
77 (erase-buffer) | |
78 (setq default-directory (file-name-as-directory dir)) | |
79 (call-process "head" nil buff nil "-n" "3" "Makefile") | |
80 (goto-char (point-min)) | |
81 (let (major minor sub) | |
82 (re-search-forward "^VERSION *= *\\([0-9.]+\\)") | |
83 (setq major (match-string 1)) | |
84 (re-search-forward "^PATCHLEVEL *= *\\([0-9.]+\\)") | |
85 (setq minor (match-string 1)) | |
86 (re-search-forward "^SUBLEVEL *= *\\([0-9.]+\\)") | |
87 (setq sub (match-string 1)) | |
88 (prog1 | |
89 (concat major "." minor "." sub) | |
90 (kill-buffer buff) | |
91 ))))) | |
92 | |
93 (defclass ede-linux-project (ede-project eieio-instance-tracker) | |
94 ((tracking-symbol :initform 'ede-linux-project-list) | |
95 ) | |
96 "Project Type for the Linux source code." | |
97 :method-invocation-order :depth-first) | |
98 | |
99 (defun ede-linux-load (dir &optional rootproj) | |
100 "Return an Linux Project object if there is a match. | |
101 Return nil if there isn't one. | |
102 Argument DIR is the directory it is created for. | |
103 ROOTPROJ is nil, since there is only one project." | |
104 (or (ede-linux-file-existing dir) | |
105 ;; Doesn't already exist, so lets make one. | |
106 (ede-linux-project "Linux" | |
107 :name (concat "Linux" (ede-linux-version dir)) | |
108 :directory dir | |
109 :file (expand-file-name "scripts/ver_linux" | |
110 dir)) | |
111 (ede-add-project-to-global-list this) | |
112 ) | |
113 ) | |
114 | |
115 (defclass ede-linux-target-c (ede-target) | |
116 () | |
117 "EDE Linux Project target for C code. | |
118 All directories need at least one target.") | |
119 | |
120 (defclass ede-linux-target-misc (ede-target) | |
121 () | |
122 "EDE Linux Project target for Misc files. | |
123 All directories need at least one target.") | |
124 | |
125 (defmethod initialize-instance ((this ede-linux-project) | |
126 &rest fields) | |
127 "Make sure the :file is fully expanded." | |
128 (call-next-method) | |
129 (unless (slot-boundp this 'targets) | |
130 (oset this :targets nil))) | |
131 | |
132 ;;; File Stuff | |
133 ;; | |
134 (defmethod ede-project-root-directory ((this ede-linux-project) | |
135 &optional file) | |
136 "Return the root for THIS Linux project with file." | |
137 (ede-up-directory (file-name-directory (oref this file)))) | |
138 | |
139 (defmethod ede-project-root ((this ede-linux-project)) | |
140 "Return my root." | |
141 this) | |
142 | |
143 (defmethod ede-find-subproject-for-directory ((proj ede-linux-project) | |
144 dir) | |
145 "Return PROJ, for handling all subdirs below DIR." | |
146 proj) | |
147 | |
148 ;;; TARGET MANAGEMENT | |
149 ;; | |
150 (defun ede-linux-find-matching-target (class dir targets) | |
151 "Find a target that is a CLASS and is in DIR in the list of TARGETS." | |
152 (let ((match nil)) | |
153 (dolist (T targets) | |
154 (when (and (object-of-class-p T class) | |
155 (string= (oref T :path) dir)) | |
156 (setq match T) | |
157 )) | |
158 match)) | |
159 | |
160 (defmethod ede-find-target ((proj ede-linux-project) buffer) | |
161 "Find an EDE target in PROJ for BUFFER. | |
162 If one doesn't exist, create a new one for this directory." | |
163 (let* ((ext (file-name-extension (buffer-file-name buffer))) | |
164 (cls (cond ((not ext) | |
165 'ede-linux-target-misc) | |
166 ((string-match "c\\|h" ext) | |
167 'ede-linux-target-c) | |
168 (t 'ede-linux-target-misc))) | |
169 (targets (oref proj targets)) | |
170 (dir default-directory) | |
171 (ans (ede-linux-find-matching-target cls dir targets)) | |
172 ) | |
173 (when (not ans) | |
174 (setq ans (make-instance | |
175 cls | |
176 :name (file-name-nondirectory | |
177 (directory-file-name dir)) | |
178 :path dir | |
179 :source nil)) | |
180 (object-add-to-list proj :targets ans) | |
181 ) | |
182 ans)) | |
183 | |
184 ;;; UTILITIES SUPPORT. | |
185 ;; | |
186 (defmethod ede-preprocessor-map ((this ede-linux-target-c)) | |
187 "Get the pre-processor map for Linux C code. | |
188 All files need the macros from lisp.h!" | |
189 (require 'semantic/db) | |
190 (let* ((proj (ede-target-parent this)) | |
191 (root (ede-project-root proj)) | |
192 (versionfile (ede-expand-filename root "include/linux/version.h")) | |
193 (table (when (and versionfile (file-exists-p versionfile)) | |
194 (semanticdb-file-table-object versionfile))) | |
195 (filemap '( ("__KERNEL__" . "") | |
196 )) | |
197 ) | |
198 (when table | |
199 (when (semanticdb-needs-refresh-p table) | |
200 (semanticdb-refresh-table table)) | |
201 (setq filemap (append filemap (oref table lexical-table))) | |
202 ) | |
203 filemap | |
204 )) | |
205 | |
206 (defun ede-linux-file-exists-name (name root subdir) | |
207 "Return a file name if NAME exists under ROOT with SUBDIR in between." | |
208 (let ((F (expand-file-name name (expand-file-name subdir root)))) | |
209 (when (file-exists-p F) F))) | |
210 | |
211 (defmethod ede-expand-filename-impl ((proj ede-linux-project) name) | |
212 "Within this project PROJ, find the file NAME. | |
213 Knows about how the Linux source tree is organized." | |
214 (let* ((ext (file-name-extension name)) | |
215 (root (ede-project-root proj)) | |
216 (dir (ede-project-root-directory root)) | |
217 (F (cond | |
218 ((not ext) nil) | |
219 ((string-match "h" ext) | |
220 (or (ede-linux-file-exists-name name dir "") | |
221 (ede-linux-file-exists-name name dir "include")) | |
222 ) | |
223 ((string-match "txt" ext) | |
224 (ede-linux-file-exists-name name dir "Documentation")) | |
225 (t nil))) | |
226 ) | |
227 (or F (call-next-method)))) | |
228 | |
229 (provide 'ede/linux) | |
230 | |
231 ;; Local variables: | |
232 ;; generated-autoload-file: "loaddefs.el" | |
233 ;; generated-autoload-feature: ede/loaddefs | |
234 ;; generated-autoload-load-name: "ede/linux" | |
235 ;; End: | |
236 | |
237 ;;; ede/linux.el ends here |