lisp/cedet/ede/emacs.el

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