diff options
Diffstat (limited to 'lisp/cedet/ede/linux.el')
| -rw-r--r-- | lisp/cedet/ede/linux.el | 159 |
1 files changed, 137 insertions, 22 deletions
diff --git a/lisp/cedet/ede/linux.el b/lisp/cedet/ede/linux.el index 728d27e4460..8a2b7c6686d 100644 --- a/lisp/cedet/ede/linux.el +++ b/lisp/cedet/ede/linux.el @@ -32,6 +32,8 @@ ;; * Add texinfo lookup options. ;; * Add website +(eval-when-compile (require 'cl)) + (require 'ede) (require 'ede/make) @@ -46,6 +48,19 @@ :group 'ede :version "24.3") +(defcustom project-linux-build-directory-default 'ask + "Build directory." + :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." + :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 @@ -109,10 +124,100 @@ DIR is the directory to search from." (defclass ede-linux-project (ede-project eieio-instance-tracker) ((tracking-symbol :initform 'ede-linux-project-list) - ) + (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. @@ -121,15 +226,20 @@ 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)) - )) + (let* ((bdir (ede-linux--get-build-directory dir)) + (arch (ede-linux--get-architecture dir bdir)) + (include-path (ede-linux--include-path dir bdir arch)) + (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) + :build-directory bdir + :architecture arch + :include-path include-path))) + (ede-add-project-to-global-list proj)))) ;;;###autoload (ede-add-project-autoload @@ -245,18 +355,23 @@ All files need the macros from lisp.h!" "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)))) (defmethod project-compile-project ((proj ede-linux-project) |