lisp/cedet/srecode/table.el

   1 ;;; srecode/table.el --- Tables of Semantic Recoders
   2
   3 ;; Copyright (C) 2007-2012 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 ;; Semantic Recoder tables manage lists of templates and the major
  25 ;; modes they are associated with.
  26 ;;
  27
  28 (require 'eieio)
  29 (require 'eieio-base)
  30 (require 'mode-local)
  31 (require 'srecode)
  32
  33 (declare-function srecode-load-tables-for-mode "srecode/find")
  34 (declare-function srecode-template-table-in-project-p "srecode/find")
  35
  36 ;;; Code:
  37
  38 ;;; TEMPLATE TABLE
  39 ;;
  40 (defclass srecode-template-table ()
  41   (;;
  42    ;; Raw file tracking
  43    ;;
  44    (file :initarg :file
  45          :type string
  46          :documentation
  47          "The name of the file this table was built from.")
  48    (filesize :initarg :filesize
  49              :type number
  50              :documentation
  51              "The size of the file when it was parsed.")
  52    (filedate :initarg :filedate
  53              :type cons
  54              :documentation
  55              "Date from the inode of the file when it was last edited.
  56 Format is from the `file-attributes' function.")
  57    (major-mode :initarg :major-mode
  58                :documentation
  59                "The major mode this table of templates is associated with.")
  60    ;;
  61    ;; Template file sorting data
  62    ;;
  63    (application :initarg :application
  64                 :type symbol
  65                 :documentation
  66                 "Tracks the name of the application these templates belong to.
  67 If this is nil, then this template table belongs to a set of generic
  68 templates that can be used with no additional dictionary values.
  69 When it is non-nil, it is assumed the template macros need specialized
  70 Emacs Lisp code to fill in the dictionary.")
  71    (framework :initarg :framework
  72               :type symbol
  73               :documentation
  74               "Tracks the name of the framework these templates belong to.
  75 If nil, then this template table belongs to any framework, or can be
  76 considered generic for all files of this language.
  77 A framework might be a specific library or build environment for which
  78 special templates are desired.  OpenGL might be a framework that
  79 exists for multiple languages.")
  80    (priority :initarg :priority
  81              :type number
  82              :documentation
  83              "For file of this Major Mode, what is the priority of this file.
  84 When there are multiple template files with similar names, templates with
  85 the highest priority are scanned last, allowing them to override values in
  86 previous template files.")
  87    (project :initarg :project
  88             :type (or null string)
  89             :documentation
  90             "Scope some project files to a specific project.
  91 The value is a directory which forms the root of a particular project,
  92 or a subset of a particular project.")
  93    ;;
  94    ;; Parsed Data from the template file
  95    ;;
  96    (templates :initarg :templates
  97               :type list
  98               :documentation
  99               "The list of templates compiled into this table.")
 100    (namehash :initarg :namehash
 101              :documentation
 102              "Hash table containing the names of all the templates.")
 103    (contexthash :initarg :contexthash
 104                 :documentation
 105                 "")
 106    (variables :initarg :variables
 107               :documentation
 108               "AList of variables.
 109 These variables are used to initialize dictionaries.")
 110    )
 111   "Semantic recoder template table.
 112 A Table contains all templates from a single .srt file.
 113 Tracks various lookup hash tables.")
 114
 115 ;;; MODE TABLE
 116 ;;
 117 (defvar srecode-mode-table-list nil
 118   "List of all the SRecode mode table classes that have been built.")
 119
 120 (defclass srecode-mode-table (eieio-instance-tracker)
 121    ((tracking-symbol :initform 'srecode-mode-table-list)
 122     (major-mode :initarg :major-mode
 123                 :documentation
 124                 "Table of template tables for this major-mode.")
 125     (modetables :initarg :modetables
 126                 :documentation
 127                 "All that tables unique to this major mode.")
 128     (tables :initarg :tables
 129             :documentation
 130             "All the tables that can be used for this major mode.")
 131     )
 132    "Track template tables for a particular major mode.
 133 Tracks all the template-tables for a specific major mode.")
 134
 135 (defun srecode-get-mode-table (mode)
 136   "Get the SRecoder mode table for the major mode MODE.
 137 This will find the mode table specific to MODE, and then
 138 calculate all inherited templates from parent modes."
 139   (let ((table nil)
 140         (tmptable nil))
 141     (while mode
 142       (setq tmptable (eieio-instance-tracker-find
 143                       mode 'major-mode 'srecode-mode-table-list)
 144             mode (get-mode-local-parent mode))
 145       (when tmptable
 146         (if (not table)
 147             (progn
 148               ;; If this is the first, update tables to have
 149               ;; all the mode specific tables in it.
 150               (setq table tmptable)
 151               (oset table tables (oref table modetables)))
 152           ;; If there already is a table, then reset the tables
 153           ;; slot to include all the tables belonging to this new child node.
 154           (oset table tables (append (oref table modetables)
 155                                      (oref tmptable modetables)))))
 156       )
 157     table))
 158
 159 (defun srecode-make-mode-table (mode)
 160   "Get the SRecoder mode table for the major mode MODE."
 161   (let ((old (eieio-instance-tracker-find
 162               mode 'major-mode 'srecode-mode-table-list)))
 163     (if old
 164         old
 165       (let* ((ms (if (stringp mode) mode (symbol-name mode)))
 166              (new (srecode-mode-table ms
 167                                       :major-mode mode
 168                                       :modetables nil
 169                                       :tables nil)))
 170         ;; Save this new mode table in that mode's variable.
 171         (eval `(setq-mode-local ,mode srecode-table ,new))
 172
 173         new))))
 174
 175 (defmethod srecode-mode-table-find ((mt srecode-mode-table) file)
 176   "Look in the mode table MT for a template table from FILE.
 177 Return nil if there was none."
 178   (object-assoc file 'file (oref mt modetables)))
 179
 180 (defun srecode-mode-table-new (mode file &rest init)
 181   "Create a new template table for MODE in FILE.
 182 INIT are the initialization parameters for the new template table."
 183   (let* ((mt (srecode-make-mode-table mode))
 184          (old (srecode-mode-table-find mt file))
 185          (attr (file-attributes file))
 186          (new (apply 'srecode-template-table
 187                      (file-name-nondirectory file)
 188                      :file file
 189                      :filesize (nth 7 attr)
 190                      :filedate (nth 5 attr)
 191                      :major-mode mode
 192                      init
 193                      )))
 194     ;; Whack the old table.
 195     (when old (object-remove-from-list mt 'modetables old))
 196     ;; Add the new table
 197     (object-add-to-list mt 'modetables new)
 198     ;; Sort the list in reverse order.  When other routines
 199     ;; go front-to-back, the highest priority items are put
 200     ;; into the search table first, allowing lower priority items
 201     ;; to be the items found in the search table.
 202     (object-sort-list mt 'modetables (lambda (a b)
 203                                        (> (oref a :priority)
 204                                           (oref b :priority))))
 205     ;; Return it.
 206     new))
 207
 208 (defun object-sort-list (object slot predicate)
 209   "Sort the items in OBJECT's SLOT.
 210 Use PREDICATE is the same as for the `sort' function."
 211   (when (slot-boundp object slot)
 212     (when (listp (eieio-oref object slot))
 213       (eieio-oset object slot (sort (eieio-oref object slot) predicate)))))
 214
 215 ;;; DEBUG
 216 ;;
 217 ;; Dump out information about the current srecoder compiled templates.
 218 ;;
 219 (defun srecode-dump-templates (mode)
 220   "Dump a list of the current templates for MODE."
 221   (interactive "sMode: ")
 222   (require 'srecode/find)
 223   (let ((modesym (cond ((string= mode "")
 224                         major-mode)
 225                        ((not (string-match "-mode" mode))
 226                         (intern-soft (concat mode "-mode")))
 227                        (t
 228                         (intern-soft mode)))))
 229     (srecode-load-tables-for-mode modesym)
 230     (let ((tmp (srecode-get-mode-table modesym))
 231           )
 232       (if (not tmp)
 233           (error "No table found for mode %S" modesym))
 234       (with-output-to-temp-buffer "*SRECODE DUMP*"
 235         (srecode-dump tmp))
 236       )))
 237
 238 (defmethod srecode-dump ((tab srecode-mode-table))
 239   "Dump the contents of the SRecode mode table TAB."
 240   (princ "MODE TABLE FOR ")
 241   (princ (oref tab :major-mode))
 242   (princ "\n--------------------------------------------\n\nNumber of tables: ")
 243   (let ((subtab (oref tab :tables)))
 244     (princ (length subtab))
 245     (princ "\n\n")
 246     (while subtab
 247       (srecode-dump (car subtab))
 248       (setq subtab (cdr subtab)))
 249     ))
 250
 251 (defmethod srecode-dump ((tab srecode-template-table))
 252   "Dump the contents of the SRecode template table TAB."
 253   (princ "Template Table for ")
 254   (princ (object-name-string tab))
 255   (princ "\nPriority: ")
 256   (prin1 (oref tab :priority))
 257   (when (oref tab :application)
 258     (princ "\nApplication: ")
 259     (princ (oref tab :application)))
 260   (when (oref tab :framework)
 261     (princ "\nFramework: ")
 262     (princ (oref tab :framework)))
 263   (when (oref tab :project)
 264     (require 'srecode/find) ; For srecode-template-table-in-project-p
 265     (princ "\nProject Directory: ")
 266     (princ (oref tab :project))
 267     (when (not (srecode-template-table-in-project-p tab))
 268       (princ "\n   ** Not Usable in this file. **")))
 269   (princ "\n\nVariables:\n")
 270   (let ((vars (oref tab variables)))
 271     (while vars
 272       (princ (car (car vars)))
 273       (princ "\t")
 274       (if (< (length (car (car vars))) 9)
 275           (princ "\t"))
 276       (prin1 (cdr (car vars)))
 277       (princ "\n")
 278       (setq vars (cdr vars))))
 279   (princ "\n\nTemplates:\n")
 280   (let ((temp (oref tab templates)))
 281     (while temp
 282       (srecode-dump (car temp))
 283       (setq temp (cdr temp))))
 284   )
 285
 286
 287 (provide 'srecode/table)
 288
 289 ;;; srecode/table.el ends here
 290