code.delx.au - gnu-emacs/blob - lisp/cedet/ede/linux.el

   1 ;;; ede/linux.el --- Special project for Linux
   2
   3 ;; Copyright (C) 2008-2013 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 (require 'ede/make)
  37
  38 (declare-function semanticdb-file-table-object "semantic/db")
  39 (declare-function semanticdb-needs-refresh-p "semantic/db")
  40 (declare-function semanticdb-refresh-table "semantic/db")
  41
  42 ;;; Code:
  43 (defgroup project-linux nil
  44   "File and tag browser frame."
  45   :group 'tools
  46   :group 'ede
  47   :version "24.3")
  48
  49 (defcustom project-linux-compile-target-command (concat ede-make-command " -k -C %s SUBDIRS=%s")
  50   "*Default command used to compile a target."
  51   :group 'project-linux
  52   :type 'string)
  53
  54 (defcustom project-linux-compile-project-command (concat ede-make-command " -k -C %s")
  55   "*Default command used to compile a project."
  56   :group 'project-linux
  57   :type 'string)
  58
  59 (defvar ede-linux-project-list nil
  60   "List of projects created by option `ede-linux-project'.")
  61
  62 (defun ede-linux-file-existing (dir)
  63   "Find a Linux project in the list of Linux projects.
  64 DIR is the directory to search from."
  65   (let ((projs ede-linux-project-list)
  66         (ans nil))
  67     (while (and projs (not ans))
  68       (let ((root (ede-project-root-directory (car projs))))
  69         (when (string-match (concat "^" (regexp-quote root)) dir)
  70           (setq ans (car projs))))
  71       (setq projs (cdr projs)))
  72     ans))
  73
  74 ;;;###autoload
  75 (defun ede-linux-project-root (&optional dir)
  76   "Get the root directory for DIR."
  77   (when (not dir) (setq dir default-directory))
  78   (let ((case-fold-search t)
  79         (proj (ede-linux-file-existing dir)))
  80     (if proj
  81         (ede-up-directory (file-name-directory
  82                            (oref proj :file)))
  83       ;; No pre-existing project.  Let's take a wild-guess if we have
  84       ;; an Linux project here.
  85       (when (string-match "linux[^/]*" dir)
  86         (let ((base (substring dir 0 (match-end 0))))
  87           (when (file-exists-p (expand-file-name "scripts/ver_linux" base))
  88               base))))))
  89
  90 (defun ede-linux-version (dir)
  91   "Find the Linux version for the Linux src in DIR."
  92   (let ((buff (get-buffer-create " *linux-query*")))
  93     (with-current-buffer buff
  94       (erase-buffer)
  95       (setq default-directory (file-name-as-directory dir))
  96       (insert-file-contents "Makefile" nil 0 512)
  97       (goto-char (point-min))
  98       (let (major minor sub)
  99         (re-search-forward "^VERSION *= *\\([0-9.]+\\)")
 100         (setq major (match-string 1))
 101         (re-search-forward "^PATCHLEVEL *= *\\([0-9.]+\\)")
 102         (setq minor (match-string 1))
 103         (re-search-forward "^SUBLEVEL *= *\\([0-9.]+\\)")
 104         (setq sub (match-string 1))
 105         (prog1
 106             (concat major "." minor "." sub)
 107           (kill-buffer buff)
 108           )))))
 109
 110 (defclass ede-linux-project (ede-project eieio-instance-tracker)
 111   ((tracking-symbol :initform 'ede-linux-project-list)
 112    )
 113   "Project Type for the Linux source code."
 114   :method-invocation-order :depth-first)
 115
 116 ;;;###autoload
 117 (defun ede-linux-load (dir &optional rootproj)
 118   "Return an Linux Project object if there is a match.
 119 Return nil if there isn't one.
 120 Argument DIR is the directory it is created for.
 121 ROOTPROJ is nil, since there is only one project."
 122   (or (ede-linux-file-existing dir)
 123       ;; Doesn't already exist, so let's make one.
 124       (let ((proj (ede-linux-project
 125                    "Linux"
 126                    :name "Linux"
 127                    :version (ede-linux-version dir)
 128                    :directory (file-name-as-directory dir)
 129                    :file (expand-file-name "scripts/ver_linux"
 130                                            dir))))
 131         (ede-add-project-to-global-list proj))
 132       ))
 133
 134 ;;;###autoload
 135 (ede-add-project-autoload
 136  (ede-project-autoload "linux"
 137                        :name "LINUX ROOT"
 138                        :file 'ede/linux
 139                        :proj-file "scripts/ver_linux"
 140                        :proj-root-dirmatch "linux[^/]*"
 141                        :proj-root 'ede-linux-project-root
 142                        :load-type 'ede-linux-load
 143                        :class-sym 'ede-linux-project
 144                        :new-p nil
 145                        :safe-p t)
 146  'unique)
 147
 148 (defclass ede-linux-target-c (ede-target)
 149   ()
 150   "EDE Linux Project target for C code.
 151 All directories need at least one target.")
 152
 153 (defclass ede-linux-target-misc (ede-target)
 154   ()
 155   "EDE Linux Project target for Misc files.
 156 All directories need at least one target.")
 157
 158 (defmethod initialize-instance ((this ede-linux-project)
 159                                 &rest fields)
 160   "Make sure the targets slot is bound."
 161   (call-next-method)
 162   (unless (slot-boundp this 'targets)
 163     (oset this :targets nil)))
 164
 165 ;;; File Stuff
 166 ;;
 167 (defmethod ede-project-root-directory ((this ede-linux-project)
 168                                        &optional file)
 169   "Return the root for THIS Linux project with file."
 170   (ede-up-directory (file-name-directory (oref this file))))
 171
 172 (defmethod ede-project-root ((this ede-linux-project))
 173   "Return my root."
 174   this)
 175
 176 (defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
 177                                               dir)
 178   "Return PROJ, for handling all subdirs below DIR."
 179   proj)
 180
 181 ;;; TARGET MANAGEMENT
 182 ;;
 183 (defun ede-linux-find-matching-target (class dir targets)
 184   "Find a target that is a CLASS and is in DIR in the list of TARGETS."
 185   (let ((match nil))
 186     (dolist (T targets)
 187       (when (and (object-of-class-p T class)
 188                  (string= (oref T :path) dir))
 189         (setq match T)
 190       ))
 191     match))
 192
 193 (defmethod ede-find-target ((proj ede-linux-project) buffer)
 194   "Find an EDE target in PROJ for BUFFER.
 195 If one doesn't exist, create a new one for this directory."
 196   (let* ((ext (file-name-extension (buffer-file-name buffer)))
 197          (cls (cond ((not ext)
 198                      'ede-linux-target-misc)
 199                     ((string-match "c\\|h" ext)
 200                      'ede-linux-target-c)
 201                     (t 'ede-linux-target-misc)))
 202          (targets (oref proj targets))
 203          (dir default-directory)
 204          (ans (ede-linux-find-matching-target cls dir targets))
 205          )
 206     (when (not ans)
 207       (setq ans (make-instance
 208                  cls
 209                  :name (file-name-nondirectory
 210                         (directory-file-name dir))
 211                  :path dir
 212                  :source nil))
 213       (object-add-to-list proj :targets ans)
 214       )
 215     ans))
 216
 217 ;;; UTILITIES SUPPORT.
 218 ;;
 219 (defmethod ede-preprocessor-map ((this ede-linux-target-c))
 220   "Get the pre-processor map for Linux C code.
 221 All files need the macros from lisp.h!"
 222   (require 'semantic/db)
 223   (let* ((proj (ede-target-parent this))
 224          (root (ede-project-root proj))
 225          (versionfile (ede-expand-filename root "include/linux/version.h"))
 226          (table (when (and versionfile (file-exists-p versionfile))
 227                   (semanticdb-file-table-object versionfile)))
 228          (filemap '( ("__KERNEL__" . "")
 229                      ))
 230          )
 231     (when table
 232       (when (semanticdb-needs-refresh-p table)
 233         (semanticdb-refresh-table table))
 234       (setq filemap (append filemap (oref table lexical-table)))
 235       )
 236     filemap
 237     ))
 238
 239 (defun ede-linux-file-exists-name (name root subdir)
 240   "Return a file name if NAME exists under ROOT with SUBDIR in between."
 241   (let ((F (expand-file-name name (expand-file-name subdir root))))
 242     (when (file-exists-p F) F)))
 243
 244 (defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
 245   "Within this project PROJ, find the file NAME.
 246 Knows about how the Linux source tree is organized."
 247   (let* ((ext (file-name-extension name))
 248          (root (ede-project-root proj))
 249          (dir (ede-project-root-directory root))
 250          (F (cond
 251              ((not ext) nil)
 252              ((string-match "h" ext)
 253               (or (ede-linux-file-exists-name name dir "")
 254                   (ede-linux-file-exists-name name dir "include"))
 255               )
 256              ((string-match "txt" ext)
 257               (ede-linux-file-exists-name name dir "Documentation"))
 258              (t nil)))
 259          )
 260     (or F (call-next-method))))
 261
 262 (defmethod project-compile-project ((proj ede-linux-project)
 263                                     &optional command)
 264   "Compile the entire current project.
 265 Argument COMMAND is the command to use when compiling."
 266   (let* ((dir (ede-project-root-directory proj)))
 267
 268     (require 'compile)
 269     (if (not project-linux-compile-project-command)
 270         (setq project-linux-compile-project-command compile-command))
 271     (if (not command)
 272         (setq command
 273               (format
 274                project-linux-compile-project-command
 275                dir)))
 276
 277     (compile command)))
 278
 279 (defmethod project-compile-target ((obj ede-linux-target-c) &optional command)
 280   "Compile the current target.
 281 Argument COMMAND is the command to use for compiling the target."
 282   (let* ((proj (ede-target-parent obj))
 283          (root (ede-project-root proj))
 284          (dir (ede-project-root-directory root))
 285          (subdir (oref obj path)))
 286
 287     (require 'compile)
 288     (if (not project-linux-compile-project-command)
 289         (setq project-linux-compile-project-command compile-command))
 290     (if (not command)
 291         (setq command
 292               (format
 293                project-linux-compile-target-command
 294                dir subdir)))
 295
 296     (compile command)))
 297
 298 (provide 'ede/linux)
 299
 300 ;; Local variables:
 301 ;; generated-autoload-file: "loaddefs.el"
 302 ;; generated-autoload-load-name: "ede/linux"
 303 ;; End:
 304
 305 ;;; ede/linux.el ends here