code.delx.au - gnu-emacs/blob - lisp/cedet/srecode/table.el

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