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     (save-excursion
  76       (set-buffer buff)
  77       (erase-buffer)
  78       (setq default-directory (file-name-as-directory dir))
  79       (insert-file-contents "Makefile" nil 0 512)
  80       (goto-char (point-min))
  81       (let (major minor sub)
  82         (re-search-forward "^VERSION *= *\\([0-9.]+\\)")
  83         (setq major (match-string 1))
  84         (re-search-forward "^PATCHLEVEL *= *\\([0-9.]+\\)")
  85         (setq minor (match-string 1))
  86         (re-search-forward "^SUBLEVEL *= *\\([0-9.]+\\)")
  87         (setq sub (match-string 1))
  88         (prog1
  89             (concat major "." minor "." sub)
  90           (kill-buffer buff)
  91           )))))
  92
  93 (defclass ede-linux-project (ede-project eieio-instance-tracker)
  94   ((tracking-symbol :initform 'ede-linux-project-list)
  95    )
  96   "Project Type for the Linux source code."
  97   :method-invocation-order :depth-first)
  98
  99 (defun ede-linux-load (dir &optional rootproj)
 100   "Return an Linux Project object if there is a match.
 101 Return nil if there isn't one.
 102 Argument DIR is the directory it is created for.
 103 ROOTPROJ is nil, since there is only one project."
 104   (or (ede-linux-file-existing dir)
 105       ;; Doesn't already exist, so lets make one.
 106       (ede-linux-project "Linux"
 107                          :name "Linux"
 108                          :version (ede-linux-version dir)
 109                          :directory (file-name-as-directory dir)
 110                          :file (expand-file-name "scripts/ver_linux"
 111                                                  dir))
 112       (ede-add-project-to-global-list this)
 113       )
 114   )
 115
 116 (defclass ede-linux-target-c (ede-target)
 117   ()
 118   "EDE Linux Project target for C code.
 119 All directories need at least one target.")
 120
 121 (defclass ede-linux-target-misc (ede-target)
 122   ()
 123   "EDE Linux Project target for Misc files.
 124 All directories need at least one target.")
 125
 126 (defmethod initialize-instance ((this ede-linux-project)
 127                                 &rest fields)
 128   "Make sure the :file is fully expanded."
 129   (call-next-method)
 130   (unless (slot-boundp this 'targets)
 131     (oset this :targets nil)))
 132
 133 ;;; File Stuff
 134 ;;
 135 (defmethod ede-project-root-directory ((this ede-linux-project)
 136                                        &optional file)
 137   "Return the root for THIS Linux project with file."
 138   (ede-up-directory (file-name-directory (oref this file))))
 139
 140 (defmethod ede-project-root ((this ede-linux-project))
 141   "Return my root."
 142   this)
 143
 144 (defmethod ede-find-subproject-for-directory ((proj ede-linux-project)
 145                                               dir)
 146   "Return PROJ, for handling all subdirs below DIR."
 147   proj)
 148
 149 ;;; TARGET MANAGEMENT
 150 ;;
 151 (defun ede-linux-find-matching-target (class dir targets)
 152   "Find a target that is a CLASS and is in DIR in the list of TARGETS."
 153   (let ((match nil))
 154     (dolist (T targets)
 155       (when (and (object-of-class-p T class)
 156                  (string= (oref T :path) dir))
 157         (setq match T)
 158       ))
 159     match))
 160
 161 (defmethod ede-find-target ((proj ede-linux-project) buffer)
 162   "Find an EDE target in PROJ for BUFFER.
 163 If one doesn't exist, create a new one for this directory."
 164   (let* ((ext (file-name-extension (buffer-file-name buffer)))
 165          (cls (cond ((not ext)
 166                      'ede-linux-target-misc)
 167                     ((string-match "c\\|h" ext)
 168                      'ede-linux-target-c)
 169                     (t 'ede-linux-target-misc)))
 170          (targets (oref proj targets))
 171          (dir default-directory)
 172          (ans (ede-linux-find-matching-target cls dir targets))
 173          )
 174     (when (not ans)
 175       (setq ans (make-instance
 176                  cls
 177                  :name (file-name-nondirectory
 178                         (directory-file-name dir))
 179                  :path dir
 180                  :source nil))
 181       (object-add-to-list proj :targets ans)
 182       )
 183     ans))
 184
 185 ;;; UTILITIES SUPPORT.
 186 ;;
 187 (defmethod ede-preprocessor-map ((this ede-linux-target-c))
 188   "Get the pre-processor map for Linux C code.
 189 All files need the macros from lisp.h!"
 190   (require 'semantic/db)
 191   (let* ((proj (ede-target-parent this))
 192          (root (ede-project-root proj))
 193          (versionfile (ede-expand-filename root "include/linux/version.h"))
 194          (table (when (and versionfile (file-exists-p versionfile))
 195                   (semanticdb-file-table-object versionfile)))
 196          (filemap '( ("__KERNEL__" . "")
 197                      ))
 198          )
 199     (when table
 200       (when (semanticdb-needs-refresh-p table)
 201         (semanticdb-refresh-table table))
 202       (setq filemap (append filemap (oref table lexical-table)))
 203       )
 204     filemap
 205     ))
 206
 207 (defun ede-linux-file-exists-name (name root subdir)
 208   "Return a file name if NAME exists under ROOT with SUBDIR in between."
 209   (let ((F (expand-file-name name (expand-file-name subdir root))))
 210     (when (file-exists-p F) F)))
 211
 212 (defmethod ede-expand-filename-impl ((proj ede-linux-project) name)
 213   "Within this project PROJ, find the file NAME.
 214 Knows about how the Linux source tree is organized."
 215   (let* ((ext (file-name-extension name))
 216          (root (ede-project-root proj))
 217          (dir (ede-project-root-directory root))
 218          (F (cond
 219              ((not ext) nil)
 220              ((string-match "h" ext)
 221               (or (ede-linux-file-exists-name name dir "")
 222                   (ede-linux-file-exists-name name dir "include"))
 223               )
 224              ((string-match "txt" ext)
 225               (ede-linux-file-exists-name name dir "Documentation"))
 226              (t nil)))
 227          )
 228     (or F (call-next-method))))
 229
 230 (provide 'ede/linux)
 231
 232 ;; Local variables:
 233 ;; generated-autoload-file: "loaddefs.el"
 234 ;; generated-autoload-feature: ede/loaddefs
 235 ;; generated-autoload-load-name: "ede/linux"
 236 ;; End:
 237
 238 ;; arch-tag: 41f310c8-b169-4259-8a2d-0ff4bd0a736d
 239 ;;; ede/linux.el ends here