lisp/cedet/ede/emacs.el

   1 ;;; ede/emacs.el --- Special project for Emacs
   2
   3 ;; Copyright (C) 2008-2014 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 Emacs, cause Emacs is special.
  25 ;;
  26 ;; Identifies an Emacs 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-emacs-project-list nil
  42   "List of projects created by option `ede-emacs-project'.")
  43
  44 (defun ede-emacs-file-existing (dir)
  45   "Find a Emacs project in the list of Emacs projects.
  46 DIR is the directory to search from."
  47   (let ((projs ede-emacs-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))
  52                             (file-name-as-directory dir))
  53           (setq ans (car projs))))
  54       (setq projs (cdr projs)))
  55     ans))
  56
  57 ;;;###autoload
  58 (defun ede-emacs-project-root (&optional dir)
  59   "Get the root directory for DIR."
  60   (when (not dir) (setq dir default-directory))
  61   (let ((case-fold-search t)
  62         (proj (ede-files-find-existing dir ede-emacs-project-list)))
  63     (if proj
  64         (ede-up-directory (file-name-directory
  65                            (oref proj :file)))
  66       ;; No pre-existing project.  Let's take a wild-guess if we have
  67       ;; an Emacs project here.
  68       (when (string-match "emacs[^/]*" dir)
  69         (let ((base (substring dir 0 (match-end 0))))
  70           (when (file-exists-p (expand-file-name "src/emacs.c" base))
  71               base))))))
  72
  73 (defun ede-emacs-version (dir)
  74   "Find the Emacs version for the Emacs src in DIR.
  75 Return a tuple of ( EMACSNAME . VERSION )."
  76   (let ((buff (get-buffer-create " *emacs-query*"))
  77         (configure_ac "configure.ac")
  78         (emacs "Emacs")
  79         (ver ""))
  80     (with-current-buffer buff
  81       (erase-buffer)
  82       (setq default-directory (file-name-as-directory dir))
  83       (or (file-exists-p configure_ac)
  84           (setq configure_ac "configure.in"))
  85       ;(call-process "egrep" nil buff nil "-n" "-e" "^version=" "Makefile")
  86       (call-process "egrep" nil buff nil "-n" "-e" "AC_INIT" configure_ac)
  87       (goto-char (point-min))
  88       ;(re-search-forward "version=\\([0-9.]+\\)")
  89       (cond
  90        ;; Maybe XEmacs?
  91        ((file-exists-p "version.sh")
  92         (setq emacs "XEmacs")
  93         (insert-file-contents "version.sh")
  94         (goto-char (point-min))
  95         (re-search-forward "emacs_major_version=\\([0-9]+\\)
  96 emacs_minor_version=\\([0-9]+\\)
  97 emacs_beta_version=\\([0-9]+\\)")
  98         (setq ver (concat (match-string 1) "."
  99                           (match-string 2) "."
 100                           (match-string 3)))
 101         )
 102        ((file-exists-p "sxemacs.pc.in")
 103         (setq emacs "SXEmacs")
 104         (insert-file-contents "sxemacs_version.m4")
 105         (goto-char (point-min))
 106         (re-search-forward "m4_define(\\[SXEM4CS_MAJOR_VERSION\\], \\[\\([0-9]+\\)\\])
 107 m4_define(\\[SXEM4CS_MINOR_VERSION\\], \\[\\([0-9]+\\)\\])
 108 m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])")
 109         (setq ver (concat (match-string 1) "."
 110                           (match-string 2) "."
 111                           (match-string 3)))
 112         )
 113        ;; Insert other Emacs here...
 114
 115        ;; Vaguely recent version of GNU Emacs?
 116        (t
 117         (insert-file-contents configure_ac)
 118         (goto-char (point-min))
 119         (re-search-forward "AC_INIT(emacs,\\s-*\\([0-9.]+\\)\\s-*)")
 120         (setq ver (match-string 1))
 121         )
 122        )
 123       ;; Return a tuple
 124       (cons emacs ver))))
 125
 126 (defclass ede-emacs-project (ede-project eieio-instance-tracker)
 127   ((tracking-symbol :initform 'ede-emacs-project-list)
 128    )
 129   "Project Type for the Emacs source code."
 130   :method-invocation-order :depth-first)
 131
 132 (defun ede-emacs-load (dir &optional rootproj)
 133   "Return an Emacs Project object if there is a match.
 134 Return nil if there isn't one.
 135 Argument DIR is the directory it is created for.
 136 ROOTPROJ is nil, since there is only one project."
 137   (or (ede-files-find-existing dir ede-emacs-project-list)
 138       ;; Doesn't already exist, so let's make one.
 139       (let* ((vertuple (ede-emacs-version dir))
 140              (proj (ede-emacs-project
 141                     (car vertuple)
 142                     :name (car vertuple)
 143                     :version (cdr vertuple)
 144                     :directory (file-name-as-directory dir)
 145                     :file (expand-file-name "src/emacs.c"
 146                                             dir))))
 147         (ede-add-project-to-global-list proj))))
 148
 149 ;;;###autoload
 150 (ede-add-project-autoload
 151  (ede-project-autoload "emacs"
 152                        :name "EMACS ROOT"
 153                        :file 'ede/emacs
 154                        :proj-file "src/emacs.c"
 155                        :proj-root-dirmatch "emacs[^/]*"
 156                        :proj-root 'ede-emacs-project-root
 157                        :load-type 'ede-emacs-load
 158                        :class-sym 'ede-emacs-project
 159                        :new-p nil
 160                        :safe-p t)
 161  'unique)
 162
 163 (defclass ede-emacs-target-c (ede-target)
 164   ()
 165   "EDE Emacs Project target for C code.
 166 All directories need at least one target.")
 167
 168 (defclass ede-emacs-target-el (ede-target)
 169   ()
 170   "EDE Emacs Project target for Emacs Lisp code.
 171 All directories need at least one target.")
 172
 173 (defclass ede-emacs-target-misc (ede-target)
 174   ()
 175   "EDE Emacs Project target for Misc files.
 176 All directories need at least one target.")
 177
 178 (defmethod initialize-instance ((this ede-emacs-project)
 179                                 &rest fields)
 180   "Make sure the targets slot is bound."
 181   (call-next-method)
 182   (unless (slot-boundp this 'targets)
 183     (oset this :targets nil)))
 184
 185 ;;; File Stuff
 186 ;;
 187 (defmethod ede-project-root-directory ((this ede-emacs-project)
 188                                        &optional file)
 189   "Return the root for THIS Emacs project with file."
 190   (ede-up-directory (file-name-directory (oref this file))))
 191
 192 (defmethod ede-project-root ((this ede-emacs-project))
 193   "Return my root."
 194   this)
 195
 196 (defmethod ede-find-subproject-for-directory ((proj ede-emacs-project)
 197                                               dir)
 198   "Return PROJ, for handling all subdirs below DIR."
 199   proj)
 200
 201 ;;; TARGET MANAGEMENT
 202 ;;
 203 (defun ede-emacs-find-matching-target (class dir targets)
 204   "Find a target that is a CLASS and is in DIR in the list of TARGETS."
 205   (let ((match nil))
 206     (dolist (T targets)
 207       (when (and (object-of-class-p T class)
 208                  (string= (oref T :path) dir))
 209         (setq match T)
 210       ))
 211     match))
 212
 213 (defmethod ede-find-target ((proj ede-emacs-project) buffer)
 214   "Find an EDE target in PROJ for BUFFER.
 215 If one doesn't exist, create a new one for this directory."
 216   (let* ((ext (file-name-extension (buffer-file-name buffer)))
 217          (cls (cond ((not ext)
 218                      'ede-emacs-target-misc)
 219                     ((string-match "c\\|h" ext)
 220                      'ede-emacs-target-c)
 221                     ((string-match "elc?" ext)
 222                      'ede-emacs-target-el)
 223                     (t 'ede-emacs-target-misc)))
 224          (targets (oref proj targets))
 225          (dir default-directory)
 226          (ans (ede-emacs-find-matching-target cls dir targets))
 227          )
 228     (when (not ans)
 229       (setq ans (make-instance
 230                  cls
 231                  :name (file-name-nondirectory
 232                         (directory-file-name dir))
 233                  :path dir
 234                  :source nil))
 235       (object-add-to-list proj :targets ans)
 236       )
 237     ans))
 238
 239 ;;; UTILITIES SUPPORT.
 240 ;;
 241 (defmethod ede-preprocessor-map ((this ede-emacs-target-c))
 242   "Get the pre-processor map for Emacs C code.
 243 All files need the macros from lisp.h!"
 244   (require 'semantic/db)
 245   (let* ((proj (ede-target-parent this))
 246          (root (ede-project-root proj))
 247          (table (semanticdb-file-table-object
 248                  (ede-expand-filename root "lisp.h")))
 249          (config (semanticdb-file-table-object
 250                   (ede-expand-filename root "config.h")))
 251          filemap
 252          )
 253     (when table
 254       (when (semanticdb-needs-refresh-p table)
 255         (semanticdb-refresh-table table))
 256       (setq filemap (append filemap (oref table lexical-table)))
 257       )
 258     (when config
 259       (when (semanticdb-needs-refresh-p config)
 260         (semanticdb-refresh-table config))
 261       (setq filemap (append filemap (oref config lexical-table)))
 262       )
 263     filemap
 264     ))
 265
 266 (defun ede-emacs-find-in-directories (name base dirs)
 267   "Find NAME is BASE directory sublist of DIRS."
 268   (let ((ans nil))
 269     (while (and dirs (not ans))
 270       (let* ((D (car dirs))
 271              (ed (expand-file-name D base))
 272              (ef (expand-file-name name ed)))
 273         (if (file-exists-p ef)
 274             (setq ans ef)
 275           ;; Not in this dir?  How about subdirs?
 276           (let ((dirfile (directory-files ed t))
 277                 (moredirs nil)
 278                 )
 279             ;; Get all the subdirs.
 280             (dolist (DF dirfile)
 281               (when (and (file-directory-p DF)
 282                          (not (string-match "\\.$" DF)))
 283                 (push DF moredirs)))
 284             ;; Try again.
 285             (setq ans (ede-emacs-find-in-directories name ed moredirs))
 286             ))
 287         (setq dirs (cdr dirs))))
 288     ans))
 289
 290 (defmethod ede-expand-filename-impl ((proj ede-emacs-project) name)
 291   "Within this project PROJ, find the file NAME.
 292 Knows about how the Emacs source tree is organized."
 293   (let* ((ext (file-name-extension name))
 294          (root (ede-project-root proj))
 295          (dir (ede-project-root-directory root))
 296          (dirs (cond
 297                 ((not ext) nil)
 298                 ((string-match "h\\|c" ext)
 299                  '("src" "lib-src" "lwlib"))
 300                 ((string-match "elc?" ext)
 301                  '("lisp"))
 302                 ((string-match "texi" ext)
 303                  '("doc"))
 304                 (t nil)))
 305          )
 306     (if (not dirs) (call-next-method)
 307       (ede-emacs-find-in-directories name dir dirs))
 308     ))
 309
 310 (provide 'ede/emacs)
 311
 312 ;; Local variables:
 313 ;; generated-autoload-file: "loaddefs.el"
 314 ;; generated-autoload-load-name: "ede/emacs"
 315 ;; End:
 316
 317 ;;; ede/emacs.el ends here