lisp/cedet/ede/locate.el

   1 ;;; ede/locate.el --- Locate support
   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 ;; Support for various LOCATE type functions.
  25 ;;
  26 ;; A key feature of EDE is `ede-expand-filename', which allows a
  27 ;; project to expand a filename reference in one file to some actual
  28 ;; filename.
  29 ;;
  30 ;; In that way, you may #include <foo.h>, and without knowing how to
  31 ;; read a Makefile, find it in <root>/include/foo.h.
  32 ;;
  33 ;; Some projects are regular, such as the Emacs project.  Some
  34 ;; projects are completely controlled by EDE, such sh the Project.ede
  35 ;; based projects.
  36 ;;
  37 ;; For other projects, having a "quick hack" to support these location
  38 ;; routines is handy.
  39 ;;
  40 ;; The baseclass `ede-locate-base' provides the abstract interface to
  41 ;; finding files in a project.
  42 ;;
  43 ;; New location routines will subclass `ede-locate-base'.
  44 ;;
  45 ;; How to use:
  46 ;;
  47 ;; Configure `ede-locate-setup-options' to add the types of locate
  48 ;; features you have available.  EDE will then enable the correct one
  49 ;; when it is available.
  50
  51 (require 'ede)
  52 (eval-when-compile (require 'locate))
  53
  54 ;;; Code:
  55 (defcustom ede-locate-setup-options
  56   '(ede-locate-base)
  57   "List of locate objects to try out by default.
  58 Listed in order of preference.  If the first item cannot be used in
  59 a particular project, then the next one is tried.
  60 It is always assumed that `ede-locate-base' is at end of the list."
  61   :group 'ede
  62   :type '(repeat
  63           (choice (const :tag "None" ede-locate-base)
  64                   (const :tag "locate" ede-locate-locate)
  65                   (const :tag "GNU Global" ede-locate-global)
  66                   (const :tag "ID Utils" ede-locate-idutils)
  67                   (const :tag "CScope" ede-locate-cscope)))
  68   )
  69
  70 ;;;###autoload
  71 (defun ede-enable-locate-on-project (&optional project)
  72   "Enable an EDE locate feature on PROJECT.
  73 Attempt to guess which project locate style to use
  74 based on `ede-locate-setup-options'."
  75   (interactive)
  76   (let* ((proj (or project (ede-toplevel)))
  77          (root (ede-project-root-directory proj))
  78          (opts ede-locate-setup-options)
  79          (ans nil))
  80     (while (and opts (not ans))
  81       (when (ede-locate-ok-in-project (car opts) root)
  82         ;; If interactive, check with the user.
  83         (when (or (not (called-interactively-p 'any))
  84                   (y-or-n-p (format "Set project locator to %s? " (car opts))))
  85           (setq ans (car opts))))
  86       (setq opts (cdr opts)))
  87     ;; No match?  Always create the baseclass for the hashing tool.
  88     (when (not ans)
  89       (when (called-interactively-p 'interactive)
  90         (message "Setting locator to ede-locate-base"))
  91       (setq ans 'ede-locate-base))
  92     (oset proj locate-obj (make-instance ans "Loc" :root root))
  93     (when (called-interactively-p 'interactive)
  94       (message "Setting locator to %s" ans))
  95     ))
  96
  97 ;;; LOCATE BASECLASS
  98 ;;
  99 ;; The baseclass for all location style queries.
 100 (defclass ede-locate-base ()
 101   ((root :initarg :root
 102          :documentation
 103          "The root of these locate searches.")
 104    (file :documentation
 105          "The last file searched for with EDE locate.")
 106    (lastanswer :documentation
 107               "The last answer provided by the locator.")
 108    (hash :documentation
 109          "Hash table of previously found files.")
 110    )
 111   "Baseclass for LOCATE feature in EDE.")
 112
 113 (cl-defmethod initialize-instance ((loc ede-locate-base) &rest fields)
 114   "Make sure we have a hash table."
 115   ;; Basic setup.
 116   (cl-call-next-method)
 117   ;; Make sure we have a hash table.
 118   (ede-locate-flush-hash loc)
 119   )
 120
 121 (cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-base))
 122                                              root)
 123   "Is it ok to use this project type under ROOT."
 124   t)
 125
 126 (cl-defmethod ede-locate-flush-hash ((loc ede-locate-base))
 127   "For LOC, flush hash table and start from scratch."
 128   (oset loc hash (make-hash-table :test 'equal)))
 129
 130 (cl-defmethod ede-locate-file-in-hash ((loc ede-locate-base)
 131                                     filestring)
 132   "For LOC, is the file FILESTRING in our hash table?"
 133   (gethash filestring (oref loc hash)))
 134
 135 (cl-defmethod ede-locate-add-file-to-hash ((loc ede-locate-base)
 136                                         filestring fullfilename)
 137   "For LOC, add FILESTR to the hash with FULLFILENAME."
 138   (puthash filestring fullfilename (oref loc hash)))
 139
 140 (cl-defmethod ede-locate-file-in-project ((loc ede-locate-base)
 141                                        filesubstring
 142                                        )
 143   "Locate with LOC occurrences of FILESUBSTRING.
 144 Searches are done under the current root of the EDE project
 145 that created this EDE locate object."
 146   (let ((ans (ede-locate-file-in-project-impl loc filesubstring))
 147         )
 148     (oset loc file filesubstring)
 149     (oset loc lastanswer ans)
 150     ans))
 151
 152 (cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-base)
 153                                             filesubstring
 154                                             )
 155   "Locate with LOC occurrences of FILESUBSTRING.
 156 Searches are done under the current root of the EDE project
 157 that created this EDE locate object."
 158   nil
 159   )
 160
 161 (cl-defmethod ede-locate-create/update-root-database
 162   ((loc (subclass ede-locate-base)) root)
 163   "Create or update the database for the current project.
 164 You cannot create projects for the baseclass."
 165   (error "Cannot create/update a database of type %S"
 166          (eieio-object-name loc)))
 167
 168 ;;; LOCATE
 169 ;;
 170 ;; Using the standard unix "locate" command.
 171 ;; Since locate is system wide, we need to hack the search
 172 ;; to restrict it to within just this project.
 173
 174 (defclass ede-locate-locate (ede-locate-base)
 175   ()
 176   "EDE Locator using the locate command.
 177 Configure the Emacs `locate-program' variable to also
 178 configure the use of EDE locate.")
 179
 180 (cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-locate))
 181                                              root)
 182   "Is it ok to use this project type under ROOT."
 183   (or (featurep 'locate) (locate-library "locate"))
 184   )
 185
 186 (cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-locate)
 187                                             filesubstring)
 188   "Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
 189 Searches are done under the current root of the EDE project
 190 that created this EDE locate object."
 191   ;; We want something like:
 192   ;;  /my/project/root*/filesubstring.c
 193   (let* ((searchstr (concat (directory-file-name (oref loc root))
 194                             "*/" filesubstring))
 195          (b (get-buffer-create "*LOCATE*"))
 196          (cd default-directory)
 197          )
 198     (with-current-buffer b
 199       (setq default-directory cd)
 200       (erase-buffer))
 201     (apply 'call-process locate-command
 202            nil b nil
 203            searchstr nil)
 204     (with-current-buffer b
 205       (split-string (buffer-string) "\n" t))
 206     )
 207   )
 208
 209 ;;; GLOBAL
 210 ;;
 211
 212 (declare-function cedet-gnu-global-version-check "cedet-global")
 213 (declare-function cedet-gnu-global-root "cedet-global")
 214 (declare-function cedet-gnu-global-expand-filename "cedet-global")
 215 (declare-function cedet-gnu-global-create/update-database "cedet-global")
 216
 217 (defclass ede-locate-global (ede-locate-base)
 218   ()
 219   "EDE Locator using GNU Global.
 220 Configure EDE's use of GNU Global through the cedet-global.el
 221 variable `cedet-global-command'.")
 222
 223 (cl-defmethod initialize-instance ((loc ede-locate-global)
 224                                 &rest slots)
 225   "Make sure that we can use GNU Global."
 226   (require 'cedet-global)
 227   ;; Get ourselves initialized.
 228   (cl-call-next-method)
 229   ;; Do the checks.
 230   (cedet-gnu-global-version-check)
 231   (let* ((default-directory (oref loc root))
 232          (root (cedet-gnu-global-root)))
 233     (when (not root)
 234       (error "No GNU Global project found for %s"
 235              (oref loc root))))
 236   )
 237
 238 (cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-global))
 239                                              root)
 240   "Is it ok to use this project type under ROOT."
 241   (require 'cedet-global)
 242   (cedet-gnu-global-version-check)
 243   (let* ((default-directory root)
 244          (newroot (cedet-gnu-global-root)))
 245     newroot))
 246
 247 (cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-global)
 248                                                filesubstring)
 249   "Locate occurrences of FILESUBSTRING in LOC, using GNU Global."
 250   (require 'cedet-global)
 251   (let ((default-directory (oref loc root)))
 252     (cedet-gnu-global-expand-filename filesubstring)))
 253
 254 (cl-defmethod ede-locate-create/update-root-database
 255   ((loc (subclass ede-locate-global)) root)
 256   "Create or update the GNU Global database for the current project."
 257   (cedet-gnu-global-create/update-database root))
 258
 259 ;;; IDUTILS
 260 ;;
 261
 262 (declare-function cedet-idutils-version-check "cedet-idutils")
 263 (declare-function cedet-idutils-support-for-directory "cedet-idutils")
 264 (declare-function cedet-idutils-expand-filename "cedet-idutils")
 265 (declare-function cedet-idutils-create/update-database "cedet-idutils")
 266
 267 (defclass ede-locate-idutils (ede-locate-base)
 268   ()
 269   "EDE Locator using IDUtils.
 270 Configure EDE's use of IDUtils through the cedet-idutils.el
 271 file name searching variable `cedet-idutils-file-command'.")
 272
 273 (cl-defmethod initialize-instance ((loc ede-locate-idutils)
 274                                 &rest slots)
 275   "Make sure that we can use IDUtils."
 276   ;; Get ourselves initialized.
 277   (cl-call-next-method)
 278   ;; Do the checks.
 279   (require 'cedet-idutils)
 280   (cedet-idutils-version-check)
 281   (when (not (cedet-idutils-support-for-directory (oref loc root)))
 282     (error "Cannot use IDUtils in %s"
 283            (oref loc root)))
 284   )
 285
 286 (cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-idutils))
 287                                              root)
 288   "Is it ok to use this project type under ROOT."
 289   (require 'cedet-idutils)
 290   (cedet-idutils-version-check)
 291   (when (cedet-idutils-support-for-directory root)
 292     root))
 293
 294 (cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-idutils)
 295                                             filesubstring)
 296   "Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
 297 Searches are done under the current root of the EDE project
 298 that created this EDE locate object."
 299   (require 'cedet-idutils)
 300   (let ((default-directory (oref loc root)))
 301     (cedet-idutils-expand-filename filesubstring)))
 302
 303 (cl-defmethod ede-locate-create/update-root-database
 304   ((loc (subclass ede-locate-idutils)) root)
 305   "Create or update the GNU Global database for the current project."
 306   (cedet-idutils-create/update-database root))
 307
 308 ;;; CSCOPE
 309 ;;
 310
 311 (declare-function cedet-cscope-version-check "cedet-cscope")
 312 (declare-function cedet-cscope-support-for-directory "cedet-cscope")
 313 (declare-function cedet-cscope-expand-filename "cedet-cscope")
 314 (declare-function cedet-cscope-create/update-database "cedet-cscope")
 315
 316 (defclass ede-locate-cscope (ede-locate-base)
 317   ()
 318   "EDE Locator using Cscope.
 319 Configure EDE's use of Cscope through the cedet-cscope.el
 320 file name searching variable `cedet-cscope-file-command'.")
 321
 322 (cl-defmethod initialize-instance ((loc ede-locate-cscope)
 323                                 &rest slots)
 324   "Make sure that we can use Cscope."
 325   ;; Get ourselves initialized.
 326   (cl-call-next-method)
 327   ;; Do the checks.
 328   (require 'cedet-cscope)
 329   (cedet-cscope-version-check)
 330   (when (not (cedet-cscope-support-for-directory (oref loc root)))
 331     (error "Cannot use Cscope in %s"
 332            (oref loc root)))
 333   )
 334
 335 (cl-defmethod ede-locate-ok-in-project ((loc (subclass ede-locate-cscope))
 336                                              root)
 337   "Is it ok to use this project type under ROOT."
 338   (require 'cedet-cscope)
 339   (cedet-cscope-version-check)
 340   (when (cedet-cscope-support-for-directory root)
 341     root))
 342
 343 (cl-defmethod ede-locate-file-in-project-impl ((loc ede-locate-cscope)
 344                                             filesubstring)
 345   "Locate with LOC occurrences of FILESUBSTRING under PROJECTROOT.
 346 Searches are done under the current root of the EDE project
 347 that created this EDE locate object."
 348   (let ((default-directory (oref loc root)))
 349     (require 'cedet-cscope)
 350     (cedet-cscope-expand-filename filesubstring)))
 351
 352 (cl-defmethod ede-locate-create/update-root-database
 353   ((loc (subclass ede-locate-cscope)) root)
 354   "Create or update the Cscope database for the current project."
 355   (require 'cedet-cscope)
 356   (cedet-cscope-create/update-database root))
 357
 358 (provide 'ede/locate)
 359
 360 ;; Local variables:
 361 ;; generated-autoload-file: "loaddefs.el"
 362 ;; generated-autoload-load-name: "ede/locate"
 363 ;; End:
 364
 365 ;;; ede/locate.el ends here