1 ;;; ede/linux.el --- Special project for Linux
3 ;; Copyright (C) 2008, 2009, 2010 Free Software Foundation, Inc.
5 ;; Author: Eric M. Ludlam <eric@siege-engine.com>
7 ;; This file is part of GNU Emacs.
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.
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.
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/>.
24 ;; Provide a special project type just for Linux, cause Linux is special.
26 ;; Identifies a Linux project automatically.
27 ;; Speedy ede-expand-filename based on extension.
28 ;; Pre-populates the preprocessor map from lisp.h
31 ;; * Add "build" options.
32 ;; * Add texinfo lookup options.
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")
41 (defvar ede-linux-project-list nil
42 "List of projects created by option `ede-linux-project'.")
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
)
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
)))
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
)))
63 (ede-up-directory (file-name-directory
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
))
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 (with-current-buffer buff
77 (setq default-directory
(file-name-as-directory dir
))
78 (insert-file-contents "Makefile" nil
0 512)
79 (goto-char (point-min))
80 (let (major minor sub
)
81 (re-search-forward "^VERSION *= *\\([0-9.]+\\)")
82 (setq major
(match-string 1))
83 (re-search-forward "^PATCHLEVEL *= *\\([0-9.]+\\)")
84 (setq minor
(match-string 1))
85 (re-search-forward "^SUBLEVEL *= *\\([0-9.]+\\)")
86 (setq sub
(match-string 1))
88 (concat major
"." minor
"." sub
)
92 (defclass ede-linux-project
(ede-project eieio-instance-tracker
)
93 ((tracking-symbol :initform
'ede-linux-project-list
)
95 "Project Type for the Linux source code."
96 :method-invocation-order
:depth-first
)
98 (defun ede-linux-load (dir &optional rootproj
)
99 "Return an Linux Project object if there is a match.
100 Return nil if there isn't one.
101 Argument DIR is the directory it is created for.
102 ROOTPROJ is nil, since there is only one project."
103 (or (ede-linux-file-existing dir
)
104 ;; Doesn't already exist, so lets make one.
105 (ede-linux-project "Linux"
107 :version
(ede-linux-version dir
)
108 :directory
(file-name-as-directory dir
)
109 :file
(expand-file-name "scripts/ver_linux"
111 (ede-add-project-to-global-list this
)
116 (add-to-list 'ede-project-class-files
117 (ede-project-autoload "linux"
120 :proj-file
"scripts/ver_linux"
121 :proj-root
'ede-linux-project-root
122 :load-type
'ede-linux-load
123 :class-sym
'ede-linux-project
127 (defclass ede-linux-target-c
(ede-target)
129 "EDE Linux Project target for C code.
130 All directories need at least one target.")
132 (defclass ede-linux-target-misc
(ede-target)
134 "EDE Linux Project target for Misc files.
135 All directories need at least one target.")
137 (defmethod initialize-instance ((this ede-linux-project
)
139 "Make sure the targets slot is bound."
141 (unless (slot-boundp this
'targets
)
142 (oset this
:targets nil
)))
146 (defmethod ede-project-root-directory ((this ede-linux-project
)
148 "Return the root for THIS Linux project with file."
149 (ede-up-directory (file-name-directory (oref this file
))))
151 (defmethod ede-project-root ((this ede-linux-project
))
155 (defmethod ede-find-subproject-for-directory ((proj ede-linux-project
)
157 "Return PROJ, for handling all subdirs below DIR."
160 ;;; TARGET MANAGEMENT
162 (defun ede-linux-find-matching-target (class dir targets
)
163 "Find a target that is a CLASS and is in DIR in the list of TARGETS."
166 (when (and (object-of-class-p T class
)
167 (string= (oref T
:path
) dir
))
172 (defmethod ede-find-target ((proj ede-linux-project
) buffer
)
173 "Find an EDE target in PROJ for BUFFER.
174 If one doesn't exist, create a new one for this directory."
175 (let* ((ext (file-name-extension (buffer-file-name buffer
)))
176 (cls (cond ((not ext
)
177 'ede-linux-target-misc
)
178 ((string-match "c\\|h" ext
)
180 (t 'ede-linux-target-misc
)))
181 (targets (oref proj targets
))
182 (dir default-directory
)
183 (ans (ede-linux-find-matching-target cls dir targets
))
186 (setq ans
(make-instance
188 :name
(file-name-nondirectory
189 (directory-file-name dir
))
192 (object-add-to-list proj
:targets ans
)
196 ;;; UTILITIES SUPPORT.
198 (defmethod ede-preprocessor-map ((this ede-linux-target-c
))
199 "Get the pre-processor map for Linux C code.
200 All files need the macros from lisp.h!"
201 (require 'semantic
/db
)
202 (let* ((proj (ede-target-parent this
))
203 (root (ede-project-root proj
))
204 (versionfile (ede-expand-filename root
"include/linux/version.h"))
205 (table (when (and versionfile
(file-exists-p versionfile
))
206 (semanticdb-file-table-object versionfile
)))
207 (filemap '( ("__KERNEL__" .
"")
211 (when (semanticdb-needs-refresh-p table
)
212 (semanticdb-refresh-table table
))
213 (setq filemap
(append filemap
(oref table lexical-table
)))
218 (defun ede-linux-file-exists-name (name root subdir
)
219 "Return a file name if NAME exists under ROOT with SUBDIR in between."
220 (let ((F (expand-file-name name
(expand-file-name subdir root
))))
221 (when (file-exists-p F
) F
)))
223 (defmethod ede-expand-filename-impl ((proj ede-linux-project
) name
)
224 "Within this project PROJ, find the file NAME.
225 Knows about how the Linux source tree is organized."
226 (let* ((ext (file-name-extension name
))
227 (root (ede-project-root proj
))
228 (dir (ede-project-root-directory root
))
231 ((string-match "h" ext
)
232 (or (ede-linux-file-exists-name name dir
"")
233 (ede-linux-file-exists-name name dir
"include"))
235 ((string-match "txt" ext
)
236 (ede-linux-file-exists-name name dir
"Documentation"))
239 (or F
(call-next-method))))
244 ;; generated-autoload-file: "loaddefs.el"
245 ;; generated-autoload-load-name: "ede/linux"
248 ;; arch-tag: 41f310c8-b169-4259-8a2d-0ff4bd0a736d
249 ;;; ede/linux.el ends here