cgit.sxemacs.org Git - packages/blob - xemacs-packages/semantic/semanticdb-file.el

   1 ;;; semanticdb-file.el --- Save a semanticdb to a cache file.
   2
   3 ;;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2007 Eric M. Ludlam
   4
   5 ;; Author: Eric M. Ludlam <zappo@gnu.org>
   6 ;; Keywords: tags
   7 ;; X-RCS: $Id: semanticdb-file.el,v 1.1 2007-11-26 15:10:46 michaels Exp $
   8
   9 ;; This file is not part of GNU Emacs.
  10
  11 ;; Semanticdb is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; This software is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25 ;;
  26 ;;; Commentary:
  27 ;;
  28 ;; A set of semanticdb classes for persistently saving caches on disk.
  29 ;;
  30
  31 (require 'semanticdb)
  32 (require 'inversion)
  33 (require 'cedet-files)
  34
  35 (defvar semanticdb-file-version semantic-version
  36   "Version of semanticdb we are writing files to disk with.")
  37 (defvar semanticdb-file-incompatible-version "1.4"
  38   "Version of semanticdb we are not reverse compatible with.")
  39
  40 ;;; Settings
  41 ;;
  42 ;;;###autoload
  43 (defcustom semanticdb-default-file-name "semantic.cache"
  44   "*File name of the semantic tag cache."
  45   :group 'semanticdb
  46   :type 'string)
  47
  48 ;;;###autoload
  49 (defcustom semanticdb-default-save-directory nil
  50   "*Directory name where semantic cache files are stored.
  51 If this value is nil, files are saved in the current directory.  If the value
  52 is a valid directory, then it overrides `semanticdb-default-file-name' and
  53 stores caches in a coded file name in this directory."
  54   :group 'semanticdb
  55   :type '(choice :tag "Default-Directory"
  56                  :menu-tag "Default-Directory"
  57                  (const :tag "Use current directory" :value nil)
  58                  (directory)))
  59
  60 ;;;###autoload
  61 (defcustom semanticdb-persistent-path '(project)
  62   "*List of valid paths that semanticdb will cache tags to.
  63 When `global-semanticdb-minor-mode' is active, tag lists will
  64 be saved to disk when Emacs exits.  Not all directories will have
  65 tags that should be saved.
  66 The value should be a list of valid paths.  A path can be a string,
  67 indicating a directory in which to save a variable.  An element in the
  68 list can also be a symbol.  Valid symbols are `never', which will
  69 disable any saving anywhere, `always', which enables saving
  70 everywhere, or `project', which enables saving in any directory that
  71 passes a list of predicates in `semanticdb-project-predicate-functions'."
  72   :group 'semanticdb
  73   :type nil)
  74
  75 (defcustom semanticdb-save-database-hooks nil
  76   "*Hooks run after a database is saved.
  77 Each function is called with one argument, the object representing
  78 the database recently written."
  79   :group 'semanticdb
  80   :type 'hook)
  81
  82 (defvar semanticdb-dir-sep-char (if (boundp 'directory-sep-char)
  83                                     (symbol-value 'directory-sep-char)
  84                                   ?/)
  85   "Character used for directory separation.
  86 Obsoleted in some versions of Emacs.  Needed in others.
  87 NOTE: This should get deleted from semantic soon.")
  88
  89 (defun semanticdb-fix-pathname (dir)
  90   "If DIR is broken, fix it.
  91 Force DIR to end with a /.
  92 Note: Same as `file-name-as-directory'.
  93 NOTE: This should get deleted from semantic soon."
  94   (file-name-as-directory dir))
  95 ;; I didn't initially know about the above fcn.  Keep the below as a
  96 ;; reference.  Delete it someday once I've proven everything is the same.
  97 ;;  (if (not (= semanticdb-dir-sep-char (aref path (1- (length path)))))
  98 ;;      (concat path (list semanticdb-dir-sep-char))
  99 ;;    path))
 100
 101 ;;; Classes
 102 ;;
 103 ;;;###autoload
 104 (defclass semanticdb-project-database-file (semanticdb-project-database
 105                                             eieio-persistent)
 106   ((file-header-line :initform ";; SEMANTICDB Tags save file")
 107    (semantic-tag-version :initarg :semantic-tag-version
 108                          :initform "1.4"
 109                          :documentation
 110                          "The version of the tags saved.
 111 The default value is 1.4.  In semantic 1.4 there was no versioning, so
 112 when those files are loaded, this becomes the version number.
 113 To save the version number, we must hand-set this version string.")
 114    (semanticdb-version :initarg :semanticdb-version
 115                        :initform "1.4"
 116                        :documentation
 117                        "The version of the object system saved.
 118 The default value is 1.4.  In semantic 1.4, there was no versioning,
 119 so when those files are loaded, this becomes the version number.
 120 To save the version number, we must hand-set this version string.")
 121    )
 122   "Database of file tables saved to disk.")
 123
 124 ;;; Code:
 125 ;;
 126 (defmethod semanticdb-create-database :STATIC ((dbc semanticdb-project-database-file)
 127                                                directory)
 128   "Create a new semantic database for DIRECTORY and return it.
 129 If a database for DIRECTORY has already been loaded, return it.
 130 If a database for DIRECTORY exists, then load that database, and return it.
 131 If DIRECTORY doesn't exist, create a new one."
 132   (let* ((fn (semanticdb-cache-filename dbc directory))
 133          (db (or (semanticdb-file-loaded-p fn)
 134                  (if (file-exists-p fn)
 135                      (progn
 136                        (semanticdb-load-database fn))))))
 137     (unless db
 138       (setq db (make-instance
 139                 dbc  ; Create the database requested.  Perhaps
 140                 (concat (file-name-nondirectory
 141                          (directory-file-name
 142                           (file-name-directory fn)))
 143                         "/")
 144                 :file fn :tables nil
 145                 :semantic-tag-version semantic-version
 146                 :semanticdb-version semanticdb-file-version)))
 147     ;; Set this up here.   We can't put it in the constructor because it
 148     ;; would be saved, and we want DB files to be portable.
 149     (oset db reference-directory directory)
 150     db))
 151
 152 ;;; File IO
 153 (defun semanticdb-load-database (filename)
 154   "Load the database FILENAME."
 155   (condition-case foo
 156       (let* ((r (eieio-persistent-read filename))
 157              (c (semanticdb-get-database-tables r))
 158              (tv (oref r semantic-tag-version))
 159              (fv (oref r semanticdb-version))
 160              )
 161         ;; Restore the parent-db connection
 162         (while c
 163           (oset (car c) parent-db r)
 164           (setq c (cdr c)))
 165         (if (not (inversion-test 'semanticdb-file fv))
 166             (when (inversion-test 'semantic-tag tv)
 167               ;; Incompatible version.  Flush tables.
 168               (semanticdb-flush-database-tables r)
 169               ;; Reset the version to new version.
 170               (oset r semantic-tag-version semantic-tag-version)
 171               ;; Warn user
 172               (message "Semanticdb file is old.  Starting over for %s"
 173                        filename)
 174               )
 175           ;; Version is not ok.  Flush whole system
 176           (message "semanticdb file is old.  Starting over for %s"
 177                    filename)
 178           ;; This database is so old, we need to replace it.
 179           ;; We also need to delete it from the instance tracker.
 180           (delete-instance r)
 181           (setq r nil))
 182         r)
 183     (error (message "Cache Error: %s, Restart" foo)
 184            nil)))
 185
 186 ;;;###autoload
 187 (defun semanticdb-file-loaded-p (filename)
 188   "Return the project belonging to FILENAME if it was already loaded."
 189   (eieio-instance-tracker-find filename 'file 'semanticdb-database-list))
 190
 191 (defmethod semanticdb-save-db ((DB semanticdb-project-database-file))
 192   "Write out the database DB to its file.
 193 If DB is not specified, then use the current database."
 194   (let ((objname (oref DB file)))
 195     (when (and (semanticdb-live-p DB)
 196                (semanticdb-write-directory-p DB))
 197       (message "Saving tag summary for %s..." objname)
 198       (condition-case foo
 199           (eieio-persistent-save (or DB semanticdb-current-database))
 200         (file-error ; System error saving?  Ignore it.
 201          (message "Error saving %s" objname))
 202         (error
 203          (cond