linux.el 13.1 KB
Newer Older
1 2
;;; ede/linux.el --- Special project for Linux

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2008-2019 Free Software Foundation, Inc.
4

Paul Eggert's avatar
Paul Eggert committed
5
;; Author: Eric M. Ludlam <zappo@gnu.org>
6 7 8 9 10 11 12 13 14 15 16 17 18 19

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
20
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
21 22 23 24 25 26 27 28 29 30 31 32 33 34 35

;;; Commentary:
;;
;; Provide a special project type just for Linux, cause Linux is special.
;;
;; Identifies a Linux project automatically.
;; Speedy ede-expand-filename based on extension.
;; Pre-populates the preprocessor map from lisp.h
;;
;; ToDo :
;; * Add "build" options.
;; * Add texinfo lookup options.
;; * Add website

(require 'ede)
Chong Yidong's avatar
Chong Yidong committed
36
(require 'ede/make)
37
(require 'semantic/db)
Glenn Morris's avatar
Glenn Morris committed
38
(eval-when-compile (require 'cl-lib))
Chong Yidong's avatar
Chong Yidong committed
39

40
;;; Code:
Chong Yidong's avatar
Chong Yidong committed
41 42 43 44
(defgroup project-linux nil
  "File and tag browser frame."
  :group 'tools
  :group 'ede
Glenn Morris's avatar
Glenn Morris committed
45
  :version "24.3")
Chong Yidong's avatar
Chong Yidong committed
46

David Engster's avatar
David Engster committed
47 48
(defcustom project-linux-build-directory-default 'ask
  "Build directory."
49
  :version "24.4"
David Engster's avatar
David Engster committed
50
  :group 'project-linux
Glenn Morris's avatar
Glenn Morris committed
51 52
  :type '(choice (const :tag "Same as source directory" same)
                 (const :tag "Ask the user" ask)))
David Engster's avatar
David Engster committed
53 54 55

(defcustom project-linux-architecture-default 'ask
  "Target architecture to assume when not auto-detected."
56
  :version "24.4"
David Engster's avatar
David Engster committed
57 58
  :group 'project-linux
  :type '(choice (string :tag "Architecture name")
Glenn Morris's avatar
Glenn Morris committed
59
                 (const :tag "Ask the user" ask)))
David Engster's avatar
David Engster committed
60 61


Chong Yidong's avatar
Chong Yidong committed
62
(defcustom project-linux-compile-target-command (concat ede-make-command " -k -C %s SUBDIRS=%s")
63
  "Default command used to compile a target."
Chong Yidong's avatar
Chong Yidong committed
64 65 66 67
  :group 'project-linux
  :type 'string)

(defcustom project-linux-compile-project-command (concat ede-make-command " -k -C %s")
68
  "Default command used to compile a project."
Chong Yidong's avatar
Chong Yidong committed
69 70 71
  :group 'project-linux
  :type 'string)

72 73 74
(defun ede-linux-version (dir)
  "Find the Linux version for the Linux src in DIR."
  (let ((buff (get-buffer-create " *linux-query*")))
75
    (with-current-buffer buff
76 77
      (erase-buffer)
      (setq default-directory (file-name-as-directory dir))
Chong Yidong's avatar
Chong Yidong committed
78
      (insert-file-contents "Makefile" nil 0 512)
79 80 81 82 83 84 85 86 87 88 89 90 91
      (goto-char (point-min))
      (let (major minor sub)
	(re-search-forward "^VERSION *= *\\([0-9.]+\\)")
	(setq major (match-string 1))
	(re-search-forward "^PATCHLEVEL *= *\\([0-9.]+\\)")
	(setq minor (match-string 1))
	(re-search-forward "^SUBLEVEL *= *\\([0-9.]+\\)")
	(setq sub (match-string 1))
	(prog1
	    (concat major "." minor "." sub)
	  (kill-buffer buff)
	  )))))

David Engster's avatar
David Engster committed
92 93
(defclass ede-linux-project (ede-project)
  ((build-directory :initarg :build-directory
David Engster's avatar
David Engster committed
94 95 96 97 98 99 100 101 102
                    :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."))
103 104 105
  "Project Type for the Linux source code."
  :method-invocation-order :depth-first)

David Engster's avatar
David Engster committed
106 107 108 109 110 111 112 113 114

(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
Glenn Morris's avatar
Glenn Morris committed
115
   (cl-case project-linux-build-directory-default
David Engster's avatar
David Engster committed
116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
     (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)))
Glenn Morris's avatar
Glenn Morris committed
164
    (cl-case arch
David Engster's avatar
David Engster committed
165 166 167 168 169 170 171 172 173 174
      (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."
Glenn Morris's avatar
Glenn Morris committed
175
  (cl-map 'list
David Engster's avatar
David Engster committed
176 177 178 179 180 181 182 183 184 185 186
       (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"))))

Chong Yidong's avatar
Chong Yidong committed
187
;;;###autoload
188
(defun ede-linux-load (dir &optional _rootproj)
189 190 191 192
  "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."
David Engster's avatar
David Engster committed
193 194 195 196
  ;; 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)))
197
    (make-instance 'ede-linux-project
David Engster's avatar
David Engster committed
198 199 200 201 202 203 204 205
     :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)))
206

Eric M. Ludlam's avatar
Eric M. Ludlam committed
207
;;;###autoload
Chong Yidong's avatar
Chong Yidong committed
208
(ede-add-project-autoload
209 210 211 212 213 214 215 216
 (make-instance 'ede-project-autoload
                :name "LINUX ROOT"
                :file 'ede/linux
                :proj-file "scripts/ver_linux"
                :load-type 'ede-linux-load
                :class-sym 'ede-linux-project
                :new-p nil
                :safe-p t)
Chong Yidong's avatar
Chong Yidong committed
217
 'unique)
Eric M. Ludlam's avatar
Eric M. Ludlam committed
218

219 220 221 222 223 224 225 226 227 228
(defclass ede-linux-target-c (ede-target)
  ()
  "EDE Linux Project target for C code.
All directories need at least one target.")

(defclass ede-linux-target-misc (ede-target)
  ()
  "EDE Linux Project target for Misc files.
All directories need at least one target.")

229
(cl-defmethod initialize-instance ((this ede-linux-project)
230
                                   &rest _fields)
Eric M. Ludlam's avatar
Eric M. Ludlam committed
231
  "Make sure the targets slot is bound."
232
  (cl-call-next-method)
233 234 235 236 237
  (unless (slot-boundp this 'targets)
    (oset this :targets nil)))

;;; File Stuff
;;
238
(cl-defmethod ede-project-root-directory ((this ede-linux-project)
239
                                          &optional _file)
240 241 242
  "Return the root for THIS Linux project with file."
  (ede-up-directory (file-name-directory (oref this file))))

243
(cl-defmethod ede-project-root ((this ede-linux-project))
244 245 246
  "Return my root."
  this)

247
(cl-defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
248
                                                 _dir)
249 250 251 252 253 254 255 256 257 258
  "Return PROJ, for handling all subdirs below DIR."
  proj)

;;; TARGET MANAGEMENT
;;
(defun ede-linux-find-matching-target (class dir targets)
  "Find a target that is a CLASS and is in DIR in the list of TARGETS."
  (let ((match nil))
    (dolist (T targets)
      (when (and (object-of-class-p T class)
259
		 (string= (oref T path) dir))
260 261 262 263
	(setq match T)
      ))
    match))

264
(cl-defmethod ede-find-target ((proj ede-linux-project) buffer)
265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289
  "Find an EDE target in PROJ for BUFFER.
If one doesn't exist, create a new one for this directory."
  (let* ((ext (file-name-extension (buffer-file-name buffer)))
	 (cls (cond ((not ext)
		     'ede-linux-target-misc)
		    ((string-match "c\\|h" ext)
		     'ede-linux-target-c)
		    (t 'ede-linux-target-misc)))
	 (targets (oref proj targets))
	 (dir default-directory)
	 (ans (ede-linux-find-matching-target cls dir targets))
	 )
    (when (not ans)
      (setq ans (make-instance
		 cls
		 :name (file-name-nondirectory
			(directory-file-name dir))
		 :path dir
		 :source nil))
      (object-add-to-list proj :targets ans)
      )
    ans))

;;; UTILITIES SUPPORT.
;;
290
(cl-defmethod ede-preprocessor-map ((this ede-linux-target-c))
291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314
  "Get the pre-processor map for Linux C code.
All files need the macros from lisp.h!"
  (require 'semantic/db)
  (let* ((proj (ede-target-parent this))
	 (root (ede-project-root proj))
	 (versionfile (ede-expand-filename root "include/linux/version.h"))
	 (table (when (and versionfile (file-exists-p versionfile))
		  (semanticdb-file-table-object versionfile)))
	 (filemap '( ("__KERNEL__" . "")
		     ))
	 )
    (when table
      (when (semanticdb-needs-refresh-p table)
	(semanticdb-refresh-table table))
      (setq filemap (append filemap (oref table lexical-table)))
      )
    filemap
    ))

(defun ede-linux-file-exists-name (name root subdir)
  "Return a file name if NAME exists under ROOT with SUBDIR in between."
  (let ((F (expand-file-name name (expand-file-name subdir root))))
    (when (file-exists-p F) F)))

315
(cl-defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
316 317 318
  "Within this project PROJ, find the file NAME.
Knows about how the Linux source tree is organized."
  (let* ((ext (file-name-extension name))
David Engster's avatar
David Engster committed
319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335
         (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))))
336
    (or F (cl-call-next-method))))
337

David Engster's avatar
David Engster committed
338 339
;;; Command Support
;;
340
(cl-defmethod project-compile-project ((proj ede-linux-project)
Chong Yidong's avatar
Chong Yidong committed
341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356
				    &optional command)
  "Compile the entire current project.
Argument COMMAND is the command to use when compiling."
  (let* ((dir (ede-project-root-directory proj)))

    (require 'compile)
    (if (not project-linux-compile-project-command)
	(setq project-linux-compile-project-command compile-command))
    (if (not command)
	(setq command
	      (format
	       project-linux-compile-project-command
	       dir)))

    (compile command)))

357
(cl-defmethod project-compile-target ((obj ede-linux-target-c) &optional command)
Chong Yidong's avatar
Chong Yidong committed
358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375
  "Compile the current target.
Argument COMMAND is the command to use for compiling the target."
  (let* ((proj (ede-target-parent obj))
	 (root (ede-project-root proj))
	 (dir (ede-project-root-directory root))
	 (subdir (oref obj path)))

    (require 'compile)
    (if (not project-linux-compile-project-command)
	(setq project-linux-compile-project-command compile-command))
    (if (not command)
	(setq command
	      (format
	       project-linux-compile-target-command
	       dir subdir)))

    (compile command)))

376
(cl-defmethod project-rescan ((this ede-linux-project))
David Engster's avatar
David Engster committed
377 378 379 380 381 382 383 384 385 386 387 388
  "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)
    ))

389 390 391 392 393 394 395 396
(provide 'ede/linux)

;; Local variables:
;; generated-autoload-file: "loaddefs.el"
;; generated-autoload-load-name: "ede/linux"
;; End:

;;; ede/linux.el ends here