| 1 | ;;; ede/emacs.el --- Special project for Emacs |
| 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 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-emacs-file-existing dir))) |
| 63 | (if proj |
| 64 | (ede-up-directory (file-name-directory |
| 65 | (oref proj :file))) |
| 66 | ;; No pre-existing project. Lets 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 | (emacs "Emacs") |
| 78 | (ver "")) |
| 79 | (with-current-buffer buff |
| 80 | (erase-buffer) |
| 81 | (setq default-directory (file-name-as-directory dir)) |
| 82 | ;(call-process "egrep" nil buff nil "-n" "-e" "^version=" "Makefile") |
| 83 | (call-process "egrep" nil buff nil "-n" "-e" "AC_INIT" "configure.in") |
| 84 | (goto-char (point-min)) |
| 85 | ;(re-search-forward "version=\\([0-9.]+\\)") |
| 86 | (cond |
| 87 | ;; Maybe XEmacs? |
| 88 | ((file-exists-p "version.sh") |
| 89 | (setq emacs "XEmacs") |
| 90 | (insert-file-contents "version.sh") |
| 91 | (goto-char (point-min)) |
| 92 | (re-search-forward "emacs_major_version=\\([0-9]+\\) |
| 93 | emacs_minor_version=\\([0-9]+\\) |
| 94 | emacs_beta_version=\\([0-9]+\\)") |
| 95 | (setq ver (concat (match-string 1) "." |
| 96 | (match-string 2) "." |
| 97 | (match-string 3))) |
| 98 | ) |
| 99 | ;; Insert other Emacs here... |
| 100 | |
| 101 | ;; Vaguely recent version of GNU Emacs? |
| 102 | (t |
| 103 | (insert-file-contents "configure.in") |
| 104 | (goto-char (point-min)) |
| 105 | (re-search-forward "AC_INIT(emacs,\\s-*\\([0-9.]+\\)\\s-*)") |
| 106 | (setq ver (match-string 1)) |
| 107 | ) |
| 108 | ) |
| 109 | ;; Return a tuple |
| 110 | (cons emacs ver)))) |
| 111 | |
| 112 | (defclass ede-emacs-project (ede-project eieio-instance-tracker) |
| 113 | ((tracking-symbol :initform 'ede-emacs-project-list) |
| 114 | ) |
| 115 | "Project Type for the Emacs source code." |
| 116 | :method-invocation-order :depth-first) |
| 117 | |
| 118 | (defun ede-emacs-load (dir &optional rootproj) |
| 119 | "Return an Emacs Project object if there is a match. |
| 120 | Return nil if there isn't one. |
| 121 | Argument DIR is the directory it is created for. |
| 122 | ROOTPROJ is nil, since there is only one project." |
| 123 | (or (ede-emacs-file-existing dir) |
| 124 | ;; Doesn't already exist, so lets make one. |
| 125 | (let* ((vertuple (ede-emacs-version dir))) |
| 126 | (ede-emacs-project (car vertuple) |
| 127 | :name (car vertuple) |
| 128 | :version (cdr vertuple) |
| 129 | :directory (file-name-as-directory dir) |
| 130 | :file (expand-file-name "src/emacs.c" |
| 131 | dir))) |
| 132 | (ede-add-project-to-global-list this) |
| 133 | ) |
| 134 | ) |
| 135 | |
| 136 | (defclass ede-emacs-target-c (ede-target) |
| 137 | () |
| 138 | "EDE Emacs Project target for C code. |
| 139 | All directories need at least one target.") |
| 140 | |
| 141 | (defclass ede-emacs-target-el (ede-target) |
| 142 | () |
| 143 | "EDE Emacs Project target for Emacs Lisp code. |
| 144 | All directories need at least one target.") |
| 145 | |
| 146 | (defclass ede-emacs-target-misc (ede-target) |
| 147 | () |
| 148 | "EDE Emacs Project target for Misc files. |
| 149 | All directories need at least one target.") |
| 150 | |
| 151 | (defmethod initialize-instance ((this ede-emacs-project) |
| 152 | &rest fields) |
| 153 | "Make sure the :file is fully expanded." |
| 154 | (call-next-method) |
| 155 | (unless (slot-boundp this 'targets) |
| 156 | (oset this :targets nil))) |
| 157 | |
| 158 | ;;; File Stuff |
| 159 | ;; |
| 160 | (defmethod ede-project-root-directory ((this ede-emacs-project) |
| 161 | &optional file) |
| 162 | "Return the root for THIS Emacs project with file." |
| 163 | (ede-up-directory (file-name-directory (oref this file)))) |
| 164 | |
| 165 | (defmethod ede-project-root ((this ede-emacs-project)) |
| 166 | "Return my root." |
| 167 | this) |
| 168 | |
| 169 | (defmethod ede-find-subproject-for-directory ((proj ede-emacs-project) |
| 170 | dir) |
| 171 | "Return PROJ, for handling all subdirs below DIR." |
| 172 | proj) |
| 173 | |
| 174 | ;;; TARGET MANAGEMENT |
| 175 | ;; |
| 176 | (defun ede-emacs-find-matching-target (class dir targets) |
| 177 | "Find a target that is a CLASS and is in DIR in the list of TARGETS." |
| 178 | (let ((match nil)) |
| 179 | (dolist (T targets) |
| 180 | (when (and (object-of-class-p T class) |
| 181 | (string= (oref T :path) dir)) |
| 182 | (setq match T) |
| 183 | )) |
| 184 | match)) |
| 185 | |
| 186 | (defmethod ede-find-target ((proj ede-emacs-project) buffer) |
| 187 | "Find an EDE target in PROJ for BUFFER. |
| 188 | If one doesn't exist, create a new one for this directory." |
| 189 | (let* ((ext (file-name-extension (buffer-file-name buffer))) |
| 190 | (cls (cond ((not ext) |
| 191 | 'ede-emacs-target-misc) |
| 192 | ((string-match "c\\|h" ext) |
| 193 | 'ede-emacs-target-c) |
| 194 | ((string-match "elc?" ext) |
| 195 | 'ede-emacs-target-el) |
| 196 | (t 'ede-emacs-target-misc))) |
| 197 | (targets (oref proj targets)) |
| 198 | (dir default-directory) |
| 199 | (ans (ede-emacs-find-matching-target cls dir targets)) |
| 200 | ) |
| 201 | (when (not ans) |
| 202 | (setq ans (make-instance |
| 203 | cls |
| 204 | :name (file-name-nondirectory |
| 205 | (directory-file-name dir)) |
| 206 | :path dir |
| 207 | :source nil)) |
| 208 | (object-add-to-list proj :targets ans) |
| 209 | ) |
| 210 | ans)) |
| 211 | |
| 212 | ;;; UTILITIES SUPPORT. |
| 213 | ;; |
| 214 | (defmethod ede-preprocessor-map ((this ede-emacs-target-c)) |
| 215 | "Get the pre-processor map for Emacs C code. |
| 216 | All files need the macros from lisp.h!" |
| 217 | (require 'semantic/db) |
| 218 | (let* ((proj (ede-target-parent this)) |
| 219 | (root (ede-project-root proj)) |
| 220 | (table (semanticdb-file-table-object |
| 221 | (ede-expand-filename root "lisp.h"))) |
| 222 | filemap |
| 223 | ) |
| 224 | (when table |
| 225 | (when (semanticdb-needs-refresh-p table) |
| 226 | (semanticdb-refresh-table table)) |
| 227 | (setq filemap (append filemap (oref table 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 | (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) (call-next-method) |
| 273 | (ede-emacs-find-in-directories name dir dirs)) |
| 274 | )) |
| 275 | |
| 276 | (provide 'ede/emacs) |
| 277 | |
| 278 | ;; Local variables: |
| 279 | ;; generated-autoload-file: "loaddefs.el" |
| 280 | ;; generated-autoload-feature: ede/loaddefs |
| 281 | ;; generated-autoload-load-name: "ede/emacs" |
| 282 | ;; End: |
| 283 | |
| 284 | ;; arch-tag: 7cd0be95-663d-4101-8799-2f8216fd8233 |
| 285 | ;;; ede/emacs.el ends here |