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

   1 ;;; ede/linux.el --- Special project for Linux
   2
   3 ;; Copyright (C) 2008, 2009, 2010, 2011, 2012 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 (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")
  39
  40 ;;; Code:
  41 (defvar ede-linux-project-list nil
  42   "List of projects created by option `ede-linux-project'.")
  43
  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)
  48         (ans nil))
  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)))
  54     ans))
  55
  56 ;;;###autoload
  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)))
  62     (if proj
  63         (ede-up-directory (file-name-directory
  64                            (oref proj :file)))
  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))
  70               base))))))
  71
  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
  76       (erase-buffer)
  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))
  87         (prog1
  88             (concat major "." minor "." sub)
  89           (kill-buffer buff)
  90           )))))
  91
  92 (defclass ede-linux-project (ede-project eieio-instance-tracker)
  93   ((tracking-symbol :initform 'ede-linux-project-list)
  94    )
  95   "Project Type for the Linux source code."
  96   :method-invocation-order :depth-first)
  97
  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"
 106                          :name "Linux"
 107                          :version (ede-linux-version dir)
 108                          :directory (file-name-as-directory dir)
 109                          :file (expand-file-name "scripts/ver_linux"
 110                                                  dir))
 111       (ede-add-project-to-global-list this)
 112       )
 113   )
 114
 115 ;;;###autoload
 116 (add-to-list 'ede-project-class-files
 117              (ede-project-autoload "linux"
 118               :name "LINUX ROOT"
 119               :file 'ede/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
 124               :new-p nil)
 125              t)
 126
 127 (defclass ede-linux-target-c (ede-target)
 128   ()
 129   "EDE Linux Project target for C code.
 130 All directories need at least one target.")
 131
 132 (defclass ede-linux-target-misc (ede-target)
 133   ()
 134   "EDE Linux Project target for Misc files.
 135 All directories need at least one target.")
 136
 137 (defmethod initialize-instance ((this ede-linux-project)
 138                                 &rest fields)
 139   "Make sure the targets slot is bound."
 140   (call-next-method)
 141   (unless (slot-boundp this 'targets)
 142     (oset this :targets nil)))
 143
 144 ;;; File Stuff
 145 ;;
 146 (defmethod ede-project-root-directory ((this ede-linux-project)
 147                                        &optional file)
 148   "Return the root for THIS Linux project with file."
 149   (ede-up-directory (file-name-directory (oref this file))))
 150
 151 (defmethod ede-project-root ((this ede-linux-project))
 152   "Return my root."
 153   this)
 154
 155 (defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
 156                                               dir)
 157   "Return PROJ, for handling all subdirs below DIR."
 158   proj)
 159
 160 ;;; TARGET MANAGEMENT
 161 ;;
 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."
 164   (let ((match nil))
 165     (dolist (T targets)
 166       (when (and (object-of-class-p T class)
 167                  (string= (oref T :path) dir))
 168         (setq match T)
 169       ))
 170     match))
 171
 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)
 179                      'ede-linux-target-c)
 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))
 184          )
 185     (when (not ans)
 186       (setq ans (make-instance
 187                  cls
 188                  :name (file-name-nondirectory
 189                         (directory-file-name dir))
 190                  :path dir
 191                  :source nil))
 192       (object-add-to-list proj :targets ans)
 193       )
 194     ans))
 195
 196 ;;; UTILITIES SUPPORT.
 197 ;;
 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__" . "")
 208                      ))
 209          )
 210     (when table
 211       (when (semanticdb-needs-refresh-p table)
 212         (semanticdb-refresh-table table))
 213       (setq filemap (append filemap (oref table lexical-table)))
 214       )
 215     filemap
 216     ))
 217
 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)))
 222
 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))
 229          (F (cond
 230              ((not ext) nil)
 231              ((string-match "h" ext)
 232               (or (ede-linux-file-exists-name name dir "")
 233                   (ede-linux-file-exists-name name dir "include"))
 234               )
 235              ((string-match "txt" ext)
 236               (ede-linux-file-exists-name name dir "Documentation"))
 237              (t nil)))
 238          )
 239     (or F (call-next-method))))
 240
 241 (provide 'ede/linux)
 242
 243 ;; Local variables:
 244 ;; generated-autoload-file: "loaddefs.el"
 245 ;; generated-autoload-load-name: "ede/linux"
 246 ;; End:
 247
 248 ;; arch-tag: 41f310c8-b169-4259-8a2d-0ff4bd0a736d
 249 ;;; ede/linux.el ends here