lisp/cedet/ede/linux.el

   1 ;;; ede/linux.el --- Special project for Linux
   2
   3 ;; Copyright (C) 2008, 2009 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 (defclass ede-linux-target-c (ede-target)
 116   ()
 117   "EDE Linux Project target for C code.
 118 All directories need at least one target.")
 119
 120 (defclass ede-linux-target-misc (ede-target)
 121   ()
 122   "EDE Linux Project target for Misc files.
 123 All directories need at least one target.")
 124
 125 (defmethod initialize-instance ((this ede-linux-project)
 126                                 &rest fields)
 127   "Make sure the :file is fully expanded."
 128   (call-next-method)
 129   (unless (slot-boundp this 'targets)
 130     (oset this :targets nil)))
 131
 132 ;;; File Stuff
 133 ;;
 134 (defmethod ede-project-root-directory ((this ede-linux-project)
 135                                        &optional file)
 136   "Return the root for THIS Linux project with file."
 137   (ede-up-directory (file-name-directory (oref this file))))
 138
 139 (defmethod ede-project-root ((this ede-linux-project))
 140   "Return my root."
 141   this)
 142
 143 (defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
 144                                               dir)
 145   "Return PROJ, for handling all subdirs below DIR."
 146   proj)
 147
 148 ;;; TARGET MANAGEMENT
 149 ;;
 150 (defun ede-linux-find-matching-target (class dir targets)
 151   "Find a target that is a CLASS and is in DIR in the list of TARGETS."
 152   (let ((match nil))
 153     (dolist (T targets)
 154       (when (and (object-of-class-p T class)
 155                  (string= (oref T :path) dir))
 156         (setq match T)
 157       ))
 158     match))
 159
 160 (defmethod ede-find-target ((proj ede-linux-project) buffer)
 161   "Find an EDE target in PROJ for BUFFER.
 162 If one doesn't exist, create a new one for this directory."
 163   (let* ((ext (file-name-extension (buffer-file-name buffer)))
 164          (cls (cond ((not ext)
 165                      'ede-linux-target-misc)
 166                     ((string-match "c\\|h" ext)
 167                      'ede-linux-target-c)
 168                     (t 'ede-linux-target-misc)))
 169          (targets (oref proj targets))
 170          (dir default-directory)
 171          (ans (ede-linux-find-matching-target cls dir targets))
 172          )
 173     (when (not ans)
 174       (setq ans (make-instance
 175                  cls
 176                  :name (file-name-nondirectory
 177                         (directory-file-name dir))
 178                  :path dir
 179                  :source nil))
 180       (object-add-to-list proj :targets ans)
 181       )
 182     ans))
 183
 184 ;;; UTILITIES SUPPORT.
 185 ;;
 186 (defmethod ede-preprocessor-map ((this ede-linux-target-c))
 187   "Get the pre-processor map for Linux C code.
 188 All files need the macros from lisp.h!"
 189   (require 'semantic/db)
 190   (let* ((proj (ede-target-parent this))
 191          (root (ede-project-root proj))
 192          (versionfile (ede-expand-filename root "include/linux/version.h"))
 193          (table (when (and versionfile (file-exists-p versionfile))
 194                   (semanticdb-file-table-object versionfile)))
 195          (filemap '( ("__KERNEL__" . "")
 196                      ))
 197          )
 198     (when table
 199       (when (semanticdb-needs-refresh-p table)
 200         (semanticdb-refresh-table table))
 201       (setq filemap (append filemap (oref table lexical-table)))
 202       )
 203     filemap
 204     ))
 205
 206 (defun ede-linux-file-exists-name (name root subdir)
 207   "Return a file name if NAME exists under ROOT with SUBDIR in between."
 208   (let ((F (expand-file-name name (expand-file-name subdir root))))
 209     (when (file-exists-p F) F)))
 210
 211 (defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
 212   "Within this project PROJ, find the file NAME.
 213 Knows about how the Linux source tree is organized."
 214   (let* ((ext (file-name-extension name))
 215          (root (ede-project-root proj))
 216          (dir (ede-project-root-directory root))
 217          (F (cond
 218              ((not ext) nil)
 219              ((string-match "h" ext)
 220               (or (ede-linux-file-exists-name name dir "")
 221                   (ede-linux-file-exists-name name dir "include"))
 222               )
 223              ((string-match "txt" ext)
 224               (ede-linux-file-exists-name name dir "Documentation"))
 225              (t nil)))
 226          )
 227     (or F (call-next-method))))
 228
 229 (provide 'ede/linux)
 230
 231 ;; Local variables:
 232 ;; generated-autoload-file: "loaddefs.el"
 233 ;; generated-autoload-feature: ede/loaddefs
 234 ;; generated-autoload-load-name: "ede/linux"
 235 ;; End:
 236
 237 ;; arch-tag: 41f310c8-b169-4259-8a2d-0ff4bd0a736d
 238 ;;; ede/linux.el ends here