lisp/cedet/semantic/db-mode.el

   1 ;;; semantic/db-mode.el --- Semanticdb Minor Mode
   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 ;; Major mode for managing Semantic Databases automatically.
  25
  26 (require 'semantic/db)
  27 ;;; Code:
  28
  29 ;; Moved into semantic/db.el:
  30 ;; (defvar semanticdb-current-database nil
  31 ;;   "For a given buffer, this is the currently active database.")
  32 ;; (make-variable-buffer-local 'semanticdb-current-database)
  33
  34 ;; (defvar semanticdb-current-table nil
  35 ;;   "For a given buffer, this is the currently active database table.")
  36 ;; (make-variable-buffer-local 'semanticdb-current-table)
  37
  38 (declare-function semantic-lex-spp-set-dynamic-table "semantic/lex-spp")
  39
  40 (defcustom semanticdb-global-mode nil
  41   "*If non-nil enable the use of `semanticdb-minor-mode'."
  42   :group 'semantic
  43   :type 'boolean
  44   :require 'semantic/db
  45   :initialize 'custom-initialize-default
  46   :set (lambda (sym val)
  47          (global-semanticdb-minor-mode (if val 1 -1))
  48          (custom-set-default sym val)))
  49
  50 (defcustom semanticdb-mode-hooks nil
  51   "*Hooks run whenever `global-semanticdb-minor-mode' is run.
  52 Use `semanticdb-minor-mode-p' to determine if the mode has been turned
  53 on or off."
  54   :group 'semanticdb
  55   :type 'hook)
  56
  57 ;;; Start/Stop database use
  58 ;;
  59 (defvar semanticdb-hooks
  60   '((semanticdb-semantic-init-hook-fcn semantic-init-db-hooks)
  61     (semanticdb-synchronize-table semantic-after-toplevel-cache-change-hook)
  62     (semanticdb-partial-synchronize-table semantic-after-partial-cache-change-hook)
  63     (semanticdb-revert-hook before-revert-hook)
  64     (semanticdb-kill-hook kill-buffer-hook)
  65     (semanticdb-kill-hook change-major-mode-hook) ;; Not really a kill, but we need the same effect.
  66     (semanticdb-kill-emacs-hook kill-emacs-hook)
  67     (semanticdb-save-all-db-idle auto-save-hook)
  68     )
  69   "List of hooks and values to add/remove when configuring semanticdb.")
  70
  71 ;;; SEMANTICDB-MODE
  72 ;;
  73 (defun semanticdb-minor-mode-p ()
  74   "Return non-nil if `semanticdb-minor-mode' is active."
  75   (member (car (car semanticdb-hooks))
  76           (symbol-value (car (cdr (car semanticdb-hooks))))))
  77
  78 (defun global-semanticdb-minor-mode (&optional arg)
  79   "Toggle the use of `semanticdb-minor-mode'.
  80 If ARG is positive, enable, if it is negative, disable.
  81 If ARG is nil, then toggle."
  82   (interactive "P")
  83   (if (not arg)
  84       (if (semanticdb-minor-mode-p)
  85           (setq arg -1)
  86         (setq arg 1)))
  87   (let ((fn 'add-hook)
  88         (h semanticdb-hooks)
  89         (changed nil))
  90     (if (< arg 0)
  91         (setq changed semanticdb-global-mode
  92               semanticdb-global-mode nil
  93               fn 'remove-hook)
  94       (setq changed (not semanticdb-global-mode)
  95             semanticdb-global-mode t))
  96     ;(message "ARG = %d" arg)
  97     (when changed
  98       (while h
  99         (funcall fn (car (cdr (car h))) (car (car h)))
 100         (setq h (cdr h)))
 101       ;; Call a hook
 102       (run-hooks 'semanticdb-mode-hooks))
 103     ))
 104
 105 (defun semanticdb-toggle-global-mode ()
 106   "Toggle use of the Semantic Database feature.
 107 Update the environment of Semantic enabled buffers accordingly."
 108   (interactive)
 109   (if (semanticdb-minor-mode-p)
 110       ;; Save databases before disabling semanticdb.
 111       (semanticdb-save-all-db))
 112   ;; Toggle semanticdb minor mode.
 113   (global-semanticdb-minor-mode))
 114
 115 ;;; Hook Functions:
 116 ;;
 117 ;; Functions used in hooks to keep SemanticDB operating.
 118 ;;
 119 (defun semanticdb-semantic-init-hook-fcn ()
 120   "Function saved in `semantic-init-db-hooks'.
 121 Sets up the semanticdb environment."
 122   ;; Only initialize semanticdb if we have a file name.
 123   ;; There is no reason to cache a tag table if there is no
 124   ;; way to load it back in later.
 125   (when (buffer-file-name)
 126     (let* ((ans (semanticdb-create-table-for-file (buffer-file-name)))
 127            (cdb (car ans))
 128            (ctbl (cdr ans))
 129            )
 130       ;; Get the current DB for this directory
 131       (setq semanticdb-current-database cdb)
 132       ;; We set the major mode because we know what it is.
 133       (oset ctbl major-mode major-mode)
 134       ;; Local state
 135       (setq semanticdb-current-table ctbl)
 136       ;; Try to swap in saved tags
 137       (if (or (not (slot-boundp ctbl 'tags)) (not (oref ctbl tags))
 138               (/= (or (oref ctbl pointmax) 0) (point-max))
 139               )
 140           (semantic-clear-toplevel-cache)
 141         ;; Unmatched syntax
 142         (condition-case nil
 143             (semantic-set-unmatched-syntax-cache
 144              (oref ctbl unmatched-syntax))
 145           (unbound-slot
 146            ;; Old version of the semanticdb table can miss the unmatched
 147            ;; syntax slot.  If so, just clear the unmatched syntax cache.
 148            (semantic-clear-unmatched-syntax-cache)
 149            ;; Make sure it has a value.
 150            (oset ctbl unmatched-syntax nil)
 151            ))
 152         ;; Keep lexical tables up to date.  Don't load
 153         ;; semantic-spp if it isn't needed.
 154         (let ((lt (oref ctbl lexical-table)))
 155           (when lt
 156             (require 'semantic/lex-spp)
 157             (semantic-lex-spp-set-dynamic-table lt)))
 158         ;; Set the main tag cache.
 159         ;; This must happen after setting up buffer local variables
 160         ;; since this will turn around and re-save those variables.
 161         (semantic--set-buffer-cache (oref ctbl tags))
 162         ;; Don't need it to be dirty.  Set dirty due to hooks from above.
 163         (oset ctbl dirty nil) ;; Special case here.
 164         (oset ctbl buffer (current-buffer))
 165         ;; Bind into the buffer.
 166         (semantic--tag-link-cache-to-buffer)
 167         )
 168       )))
 169
 170 (defun semanticdb-revert-hook ()
 171   "Hook run before a revert buffer.
 172 We can't track incremental changes due to a revert, so just clear the cache.
 173 This will prevent the next batch of hooks from wasting time parsing things
 174 that don't need to be parsed."
 175   (if (and (semantic-active-p)
 176            semantic--buffer-cache
 177            semanticdb-current-table)
 178       (semantic-clear-toplevel-cache)))
 179
 180 (defun semanticdb-kill-hook ()
 181   "Function run when a buffer is killed.
 182 If there is a semantic cache, slurp out the overlays, and store
 183 it in our database.  If that buffer has no cache, ignore it, we'll
 184 handle it later if need be."
 185   (when (and (semantic-active-p)
 186              semantic--buffer-cache
 187              semanticdb-current-table)
 188
 189     ;; Try to get a fast update.
 190     (semantic-fetch-tags-fast)
 191
 192     ;; If the buffer is in a bad state, don't save anything...
 193     (if (semantic-parse-tree-needs-rebuild-p)
 194         ;; If this is the case, don't save anything.
 195         (progn
 196           (semantic-clear-toplevel-cache)
 197           (oset semanticdb-current-table pointmax 0)
 198           (oset semanticdb-current-table fsize 0)
 199           (oset semanticdb-current-table lastmodtime nil)
 200           )
 201       ;; We have a clean buffer, save it off.
 202       (condition-case nil
 203           (progn
 204             (semantic--tag-unlink-cache-from-buffer)
 205             ;; Set pointmax only if we had some success in the unlink.
 206             (oset semanticdb-current-table pointmax (point-max))
 207             (let ((fattr (file-attributes
 208                           (semanticdb-full-filename
 209                            semanticdb-current-table))))
 210               (oset semanticdb-current-table fsize (nth 7 fattr))
 211               (oset semanticdb-current-table lastmodtime (nth 5 fattr))
 212               (oset semanticdb-current-table buffer nil)
 213               ))
 214         ;; If this messes up, just clear the system
 215         (error
 216          (semantic-clear-toplevel-cache)
 217          (message "semanticdb: Failed to deoverlay tag cache.")))
 218       )
 219     ))
 220
 221 (defun semanticdb-kill-emacs-hook ()
 222   "Function called when Emacs is killed.
 223 Save all the databases."
 224   (semanticdb-save-all-db))
 225
 226 ;;; SYNCHRONIZATION HOOKS
 227 ;;
 228 (defun semanticdb-synchronize-table (new-table)
 229   "Function run after parsing.
 230 Argument NEW-TABLE is the new table of tags."
 231   (when semanticdb-current-table
 232     (semanticdb-synchronize semanticdb-current-table new-table)))
 233
 234 (defun semanticdb-partial-synchronize-table (new-table)
 235   "Function run after parsing.
 236 Argument NEW-TABLE is the new table of tags."
 237   (when semanticdb-current-table
 238     (semanticdb-partial-synchronize semanticdb-current-table new-table)))
 239
 240
 241 (provide 'semantic/db-mode)
 242
 243 ;;; semantic/db-mode.el ends here