;;; ede/linux.el --- Special project for Linux
-;; Copyright (C) 2008-2013 Free Software Foundation, Inc.
+;; Copyright (C) 2008-2015 Free Software Foundation, Inc.
;; Author: Eric M. Ludlam <eric@siege-engine.com>
;; * Add texinfo lookup options.
;; * Add website
+(eval-when-compile (require 'cl))
+
(require 'ede)
(require 'ede/make)
:group 'ede
:version "24.3")
+(defcustom project-linux-build-directory-default 'ask
+ "Build directory."
+ :version "24.4"
+ :group 'project-linux
+ :type '(choice (const :tag "Same as source directory" same)
+ (const :tag "Ask the user" ask)))
+
+(defcustom project-linux-architecture-default 'ask
+ "Target architecture to assume when not auto-detected."
+ :version "24.4"
+ :group 'project-linux
+ :type '(choice (string :tag "Architecture name")
+ (const :tag "Ask the user" ask)))
+
+
(defcustom project-linux-compile-target-command (concat ede-make-command " -k -C %s SUBDIRS=%s")
"*Default command used to compile a target."
:group 'project-linux
:group 'project-linux
:type 'string)
-(defvar ede-linux-project-list nil
- "List of projects created by option `ede-linux-project'.")
-
-(defun ede-linux-file-existing (dir)
- "Find a Linux project in the list of Linux projects.
-DIR is the directory to search from."
- (let ((projs ede-linux-project-list)
- (ans nil))
- (while (and projs (not ans))
- (let ((root (ede-project-root-directory (car projs))))
- (when (string-match (concat "^" (regexp-quote root)) dir)
- (setq ans (car projs))))
- (setq projs (cdr projs)))
- ans))
-
-;;;###autoload
-(defun ede-linux-project-root (&optional dir)
- "Get the root directory for DIR."
- (when (not dir) (setq dir default-directory))
- (let ((case-fold-search t)
- (proj (ede-linux-file-existing dir)))
- (if proj
- (ede-up-directory (file-name-directory
- (oref proj :file)))
- ;; No pre-existing project. Let's take a wild-guess if we have
- ;; an Linux project here.
- (when (string-match "linux[^/]*" dir)
- (let ((base (substring dir 0 (match-end 0))))
- (when (file-exists-p (expand-file-name "scripts/ver_linux" base))
- base))))))
-
(defun ede-linux-version (dir)
"Find the Linux version for the Linux src in DIR."
(let ((buff (get-buffer-create " *linux-query*")))
(kill-buffer buff)
)))))
-(defclass ede-linux-project (ede-project eieio-instance-tracker)
- ((tracking-symbol :initform 'ede-linux-project-list)
- )
+(defclass ede-linux-project (ede-project)
+ ((build-directory :initarg :build-directory
+ :type string
+ :documentation "Build directory.")
+ (architecture :initarg :architecture
+ :type string
+ :documentation "Target architecture.")
+ (include-path :initarg :include-path
+ :type list
+ :documentation "Include directories.
+Contains both common and target architecture-specific directories."))
"Project Type for the Linux source code."
:method-invocation-order :depth-first)
+
+(defun ede-linux--get-build-directory (dir)
+ "Detect build directory for sources in DIR.
+If DIR has not been used as a build directory, fall back to
+`project-linux-build-directory-default'."
+ (or
+ ;; detected build on source directory
+ (and (file-exists-p (expand-file-name ".config" dir)) dir)
+ ;; use configuration
+ (case project-linux-build-directory-default
+ (same dir)
+ (ask (read-directory-name "Select Linux' build directory: " dir)))))
+
+
+(defun ede-linux--get-archs (dir)
+ "Returns a list of architecture names found in DIR."
+ (let ((archs-dir (expand-file-name "arch" dir))
+ archs)
+ (when (file-directory-p archs-dir)
+ (mapc (lambda (elem)
+ (when (and
+ (not (string= elem "."))
+ (not (string= elem ".."))
+ (not (string= elem "x86_64")) ; has no separate sources
+ (file-directory-p
+ (expand-file-name elem archs-dir)))
+ (add-to-list 'archs elem t)))
+ (directory-files archs-dir)))
+ archs))
+
+
+(defun ede-linux--detect-architecture (dir)
+ "Try to auto-detect the architecture as configured in DIR.
+DIR is Linux' build directory. If it cannot be auto-detected,
+returns `project-linux-architecture-default'."
+ (let ((archs-dir (expand-file-name "arch" dir))
+ (archs (ede-linux--get-archs dir))
+ arch found)
+ (or (and
+ archs
+ ;; Look for /arch/<arch>/include/generated
+ (progn
+ (while (and archs (not found))
+ (setq arch (car archs))
+ (when (file-directory-p
+ (expand-file-name (concat arch "/include/generated")
+ archs-dir))
+ (setq found arch))
+ (setq archs (cdr archs)))
+ found))
+ project-linux-architecture-default)))
+
+(defun ede-linux--get-architecture (dir bdir)
+ "Try to auto-detect the architecture as configured in BDIR.
+Uses `ede-linux--detect-architecture' for the auto-detection. If
+the result is `ask', let the user choose from architectures found
+in DIR."
+ (let ((arch (ede-linux--detect-architecture bdir)))
+ (case arch
+ (ask
+ (completing-read "Select target architecture: "
+ (ede-linux--get-archs dir)))
+ (t arch))))
+
+
+(defun ede-linux--include-path (dir bdir arch)
+ "Returns a list with include directories.
+Returned directories might not exist, since they are not created
+until Linux is built for the first time."
+ (map 'list
+ (lambda (elem) (format (concat (car elem) "/" (cdr elem)) arch))
+ ;; XXX: taken from the output of "make V=1"
+ (list (cons dir "arch/%s/include")
+ (cons bdir "arch/%s/include/generated")
+ (cons dir "include")
+ (cons bdir "include")
+ (cons dir "arch/%s/include/uapi")
+ (cons bdir "arch/%s/include/generated/uapi")
+ (cons dir "include/uapi")
+ (cons bdir "include/generated/uapi"))))
+
;;;###autoload
(defun ede-linux-load (dir &optional rootproj)
"Return an Linux Project object if there is a match.
Return nil if there isn't one.
Argument DIR is the directory it is created for.
ROOTPROJ is nil, since there is only one project."
- (or (ede-linux-file-existing dir)
- ;; Doesn't already exist, so let's make one.
- (let ((proj (ede-linux-project
- "Linux"
- :name "Linux"
- :version (ede-linux-version dir)
- :directory (file-name-as-directory dir)
- :file (expand-file-name "scripts/ver_linux"
- dir))))
- (ede-add-project-to-global-list proj))
- ))
+ ;; Doesn't already exist, so let's make one.
+ (let* ((bdir (ede-linux--get-build-directory dir))
+ (arch (ede-linux--get-architecture dir bdir))
+ (include-path (ede-linux--include-path dir bdir arch)))
+ (ede-linux-project
+ "Linux"
+ :name "Linux"
+ :version (ede-linux-version dir)
+ :directory (file-name-as-directory dir)
+ :file (expand-file-name "scripts/ver_linux"
+ dir)
+ :build-directory bdir
+ :architecture arch
+ :include-path include-path)))
;;;###autoload
(ede-add-project-autoload
:name "LINUX ROOT"
:file 'ede/linux
:proj-file "scripts/ver_linux"
- :proj-root-dirmatch "linux[^/]*"
- :proj-root 'ede-linux-project-root
:load-type 'ede-linux-load
:class-sym 'ede-linux-project
:new-p nil
"Within this project PROJ, find the file NAME.
Knows about how the Linux source tree is organized."
(let* ((ext (file-name-extension name))
- (root (ede-project-root proj))
- (dir (ede-project-root-directory root))
- (F (cond
- ((not ext) nil)
- ((string-match "h" ext)
- (or (ede-linux-file-exists-name name dir "")
- (ede-linux-file-exists-name name dir "include"))
- )
- ((string-match "txt" ext)
- (ede-linux-file-exists-name name dir "Documentation"))
- (t nil)))
- )
+ (root (ede-project-root proj))
+ (dir (ede-project-root-directory root))
+ (bdir (oref proj build-directory))
+ (F (cond
+ ((not ext) nil)
+ ((string-match "h" ext)
+ (let ((dirs (oref proj include-path))
+ found)
+ (while (and dirs (not found))
+ (setq found
+ (or (ede-linux-file-exists-name name bdir (car dirs))
+ (ede-linux-file-exists-name name dir (car dirs))))
+ (setq dirs (cdr dirs)))
+ found))
+ ((string-match "txt" ext)
+ (ede-linux-file-exists-name name dir "Documentation"))
+ (t nil))))
(or F (call-next-method))))
+;;; Command Support
+;;
(defmethod project-compile-project ((proj ede-linux-project)
&optional command)
"Compile the entire current project.
(compile command)))
+(defmethod project-rescan ((this ede-linux-project))
+ "Rescan this Linux project from the sources."
+ (let* ((dir (ede-project-root-directory this))
+ (bdir (ede-linux--get-build-directory dir))
+ (arch (ede-linux--get-architecture dir bdir))
+ (inc (ede-linux--include-path dir bdir arch))
+ (ver (ede-linux-version dir)))
+ (oset this version ver)
+ (oset this :build-directory bdir)
+ (oset this :architecture arch)
+ (oset this :include-path inc)
+ ))
+
(provide 'ede/linux)
;; Local variables: