;;; ede/emacs.el --- Special project for Emacs ;; Copyright (C) 2008-2021 Free Software Foundation, Inc. ;; Author: Eric M. Ludlam ;; This file is part of GNU Emacs. ;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs. If not, see . ;;; Commentary: ;; ;; Provide a special project type just for Emacs, cause Emacs is special. ;; ;; Identifies an Emacs project automatically. ;; Speedy ede-expand-filename based on extension. ;; Pre-populates the preprocessor map from lisp.h ;; ;; ToDo : ;; * Add "build" options. ;; * Add texinfo lookup options. ;; * Add website (require 'ede) (require 'semantic/db) ;;; Code: ;; @TODO - get rid of this. Stuck in loaddefs right now. (defun ede-emacs-project-root (&optional _dir) "Get the root directory for DIR." nil) (defun ede-emacs-version (dir) "Find the Emacs version for the Emacs src in DIR. Return a tuple of ( EMACSNAME . VERSION )." (let ((buff (get-buffer-create " *emacs-query*")) (configure_ac "configure.ac") (emacs "Emacs") (ver "")) (with-current-buffer buff (erase-buffer) (setq default-directory (file-name-as-directory dir)) (cond ;; Maybe XEmacs? ((file-exists-p "version.sh") (setq emacs "XEmacs") (insert-file-contents "version.sh") (goto-char (point-min)) (re-search-forward "emacs_major_version=\\([0-9]+\\) emacs_minor_version=\\([0-9]+\\) emacs_beta_version=\\([0-9]+\\)") (setq ver (concat (match-string 1) "." (match-string 2) "." (match-string 3))) ) ((file-exists-p "sxemacs.pc.in") (setq emacs "SXEmacs") (insert-file-contents "sxemacs_version.m4") (goto-char (point-min)) (re-search-forward "m4_define(\\[SXEM4CS_MAJOR_VERSION\\], \\[\\([0-9]+\\)\\]) m4_define(\\[SXEM4CS_MINOR_VERSION\\], \\[\\([0-9]+\\)\\]) m4_define(\\[SXEM4CS_BETA_VERSION\\], \\[\\([0-9]+\\)\\])") (setq ver (concat (match-string 1) "." (match-string 2) "." (match-string 3))) ) ;; Insert other Emacs here... ;; Vaguely recent version of GNU Emacs? ((or (file-exists-p configure_ac) (file-exists-p (setq configure_ac "configure.in"))) (insert-file-contents configure_ac) (goto-char (point-min)) (re-search-forward "AC_INIT(\\(?:GNU \\)?[eE]macs,\\s-*\\([0-9.]+\\)\\s-*[,)]") (setq ver (match-string 1)) ) ) ;; Return a tuple (cons emacs ver)))) (defclass ede-emacs-project (ede-project) ( ) "Project Type for the Emacs source code." :method-invocation-order :depth-first) (defun ede-emacs-load (dir &optional _rootproj) "Return an Emacs Project object if there is a match. Return nil if there isn't one. Argument DIR is the directory it is created for. ROOTPROJ is nil, since there is only one project." ;; Doesn't already exist, so let's make one. (let* ((vertuple (ede-emacs-version dir))) (ede-emacs-project (car vertuple) :name (car vertuple) :version (cdr vertuple) :directory (file-name-as-directory dir) :file (expand-file-name "src/emacs.c" dir)))) ;;;###autoload (ede-add-project-autoload (make-instance 'ede-project-autoload :name "EMACS ROOT" :file 'ede/emacs :proj-file "src/emacs.c" :load-type 'ede-emacs-load :class-sym 'ede-emacs-project :new-p nil :safe-p t) 'unique) (defclass ede-emacs-target-c (ede-target) () "EDE Emacs Project target for C code. All directories need at least one target.") (defclass ede-emacs-target-el (ede-target) () "EDE Emacs Project target for Emacs Lisp code. All directories need at least one target.") (defclass ede-emacs-target-misc (ede-target) () "EDE Emacs Project target for Misc files. All directories need at least one target.") (cl-defmethod initialize-instance ((this ede-emacs-project) &rest _fields) "Make sure the targets slot is bound." (cl-call-next-method) (unless (slot-boundp this 'targets) (oset this :targets nil))) ;;; File Stuff ;; (cl-defmethod ede-project-root-directory ((this ede-emacs-project) &optional _file) "Return the root for THIS Emacs project with file." (ede-up-directory (file-name-directory (oref this file)))) (cl-defmethod ede-project-root ((this ede-emacs-project)) "Return my root." this) (cl-defmethod ede-find-subproject-for-directory ((proj ede-emacs-project) _dir) "Return PROJ, for handling all subdirs below DIR." proj) ;;; TARGET MANAGEMENT ;; (defun ede-emacs-find-matching-target (class dir targets) "Find a target that is a CLASS and is in DIR in the list of TARGETS." (let ((match nil)) (dolist (T targets) (when (and (object-of-class-p T class) (string= (oref T path) dir)) (setq match T) )) match)) (cl-defmethod ede-find-target ((proj ede-emacs-project) buffer) "Find an EDE target in PROJ for BUFFER. If one doesn't exist, create a new one for this directory." (let* ((ext (file-name-extension (buffer-file-name buffer))) (cls (cond ((not ext) 'ede-emacs-target-misc) ((string-match "c\\|h" ext) 'ede-emacs-target-c) ((string-match "elc?" ext) 'ede-emacs-target-el) (t 'ede-emacs-target-misc))) (targets (oref proj targets)) (dir default-directory) (ans (ede-emacs-find-matching-target cls dir targets)) ) (when (not ans) (setq ans (make-instance cls :name (file-name-nondirectory (directory-file-name dir)) :path dir :source nil)) (object-add-to-list proj :targets ans) ) ans)) ;;; UTILITIES SUPPORT. ;; (cl-defmethod ede-preprocessor-map ((this ede-emacs-target-c)) "Get the pre-processor map for Emacs C code. All files need the macros from lisp.h!" (require 'semantic/db) (let* ((proj (ede-target-parent this)) (root (ede-project-root proj)) (table (semanticdb-file-table-object (ede-expand-filename root "lisp.h"))) (config (semanticdb-file-table-object (ede-expand-filename root "config.h"))) filemap ) (when table (when (semanticdb-needs-refresh-p table) (semanticdb-refresh-table table)) (setq filemap (append filemap (oref table lexical-table))) ) (when config (when (semanticdb-needs-refresh-p config) (semanticdb-refresh-table config)) (setq filemap (append filemap (oref config lexical-table))) ) filemap )) (defun ede-emacs-find-in-directories (name base dirs) "Find NAME is BASE directory sublist of DIRS." (let ((ans nil)) (while (and dirs (not ans)) (let* ((D (car dirs)) (ed (expand-file-name D base)) (ef (expand-file-name name ed))) (when (file-exists-p ed) (if (file-exists-p ef) (setq ans ef) ;; Not in this dir? How about subdirs? (let ((dirfile (directory-files ed t)) (moredirs nil)) ;; Get all the subdirs. (dolist (DF dirfile) (when (and (file-directory-p DF) (not (string-match "\\.$" DF))) (push DF moredirs))) ;; Try again. (setq ans (ede-emacs-find-in-directories name ed moredirs))))) (setq dirs (cdr dirs)))) ans)) (cl-defmethod ede-expand-filename-impl ((proj ede-emacs-project) name) "Within this project PROJ, find the file NAME. Knows about how the Emacs source tree is organized." (let* ((ext (file-name-extension name)) (root (ede-project-root proj)) (dir (ede-project-root-directory root)) (dirs (cond ((not ext) nil) ((string-match "h\\|c" ext) '("src" "lib-src" "lwlib")) ((string-match "elc?" ext) '("lisp")) ((string-match "texi" ext) '("doc")) (t nil))) ) (if (not dirs) (cl-call-next-method) (ede-emacs-find-in-directories name dir dirs)) )) ;;; Command Support ;; (cl-defmethod project-rescan ((this ede-emacs-project)) "Rescan this Emacs project from the sources." (let ((ver (ede-emacs-version (ede-project-root-directory this)))) (oset this name (car ver)) (oset this version (cdr ver)) )) (provide 'ede/emacs) ;; Local variables: ;; generated-autoload-file: "loaddefs.el" ;; generated-autoload-load-name: "ede/emacs" ;; End: ;;; ede/emacs.el ends here