Update copyright notices for 2013.
[bpt/emacs.git] / lisp / cedet / srecode / compile.el
index 3caab23..170b99c 100644 (file)
@@ -1,6 +1,6 @@
 ;;; srecode/compile --- Compilation of srecode template files.
 
-;; Copyright (C) 2005, 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
+;; Copyright (C) 2005, 2007-2013 Free Software Foundation, Inc.
 
 ;; Author: Eric M. Ludlam <zappo@gnu.org>
 ;; Keywords: codegeneration
 (require 'semantic)
 (require 'eieio)
 (require 'eieio-base)
-(require 'srecode)
 (require 'srecode/table)
+(require 'srecode/dictionary)
 
 (declare-function srecode-template-inserter-newline-child-p "srecode/insert"
                  t t)
-(declare-function srecode-create-section-dictionary "srecode/dictionary")
-(declare-function srecode-dictionary-compound-variable "srecode/dictionary")
 
 ;;; Code:
 
 ;;; Template Class
 ;;
-;; Templatets describe a patter of text that can be inserted into a
+;; Templates describe a pattern of text that can be inserted into a
 ;; buffer.
 ;;
 (defclass srecode-template (eieio-named)
    (dictionary :initarg :dictionary
               :type (or null srecode-dictionary)
               :documentation
-              "List of section dictinaries.
+              "List of section dictionaries.
 The compiled template can contain lists of section dictionaries,
 or values that are expected to be passed down into different
 section macros.  The template section dictionaries are merged in with
-any incomming dictionaries values.")
+any incoming dictionaries values.")
    (binding :initarg :binding
            :documentation
            "Preferred keybinding for this template in `srecode-minor-mode-map'.")
@@ -105,7 +103,7 @@ stack is broken."
 ;; work, and the smaller, simple inserter object is saved in
 ;; the compiled templates.
 ;;
-;; See srecode-insert.el for the specialized classes.
+;; See srecode/insert.el for the specialized classes.
 ;;
 (defclass srecode-template-inserter (eieio-named)
   ((secondname :initarg :secondname
@@ -201,6 +199,8 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
 (defun srecode-compile-templates ()
   "Compile a semantic recode template file into a mode-local variable."
   (interactive)
+  (unless (semantic-active-p)
+    (error "You have to activate semantic-mode to compile SRecode templates."))
   (require 'srecode/insert)
   (message "Compiling template %s..."
           (file-name-nondirectory (buffer-file-name)))
@@ -212,7 +212,9 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
                                       (buffer-file-name))))
        (mode nil)
        (application nil)
+       (framework nil)
        (priority nil)
+       (project nil)
        (vars nil)
        )
 
@@ -254,8 +256,12 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
                     )
                    ((string= name "application")
                     (setq application (read firstvalue)))
+                   ((string= name "framework")
+                    (setq framework (read firstvalue)))
                    ((string= name "priority")
                     (setq priority (read firstvalue)))
+                   ((string= name "project")
+                    (setq project firstvalue))
                    (t
                     ;; Assign this into some table of variables.
                     (setq vars (cons (cons name firstvalue) vars))
@@ -297,12 +303,19 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
     ;; Calculate priority
     ;;
     (if (not priority)
-       (let ((d (file-name-directory (buffer-file-name)))
-             (sd (file-name-directory (locate-library "srecode")))
-             (defaultdelta (if (eq mode 'default) 20 0)))
-         (if (string= d sd)
-             (setq priority (+ 80 defaultdelta))
-           (setq priority (+ 30 defaultdelta)))
+       (let ((d (expand-file-name (file-name-directory (buffer-file-name))))
+             (sd (expand-file-name (file-name-directory (locate-library "srecode"))))
+             (defaultdelta (if (eq mode 'default) 0 10)))
+         ;; @TODO :   WHEN INTEGRATING INTO EMACS
+         ;;   The location of Emacs default templates needs to be specified
+         ;;   here to also have a lower priority.
+         (if (string-match (concat "^" sd) d)
+             (setq priority (+ 30 defaultdelta))
+           ;; If the user created template is for a project, then
+           ;; don't add as much as if it is unique to just some user.
+           (if (stringp project)
+               (setq priority (+ 50 defaultdelta))
+             (setq priority (+ 80 defaultdelta))))
          (message "Templates %s has estimated priority of %d"
                   (file-name-nondirectory (buffer-file-name))
                   priority))
@@ -311,56 +324,56 @@ Arguments ESCAPE-START and ESCAPE-END are the current escape sequences in use."
               priority))
 
     ;; Save it up!
-    (srecode-compile-template-table table mode priority application vars)
+    (srecode-compile-template-table table mode priority application framework project vars)
     )
 )
 
-(defun srecode-compile-one-template-tag (tag STATE)
-  "Compile a template tag TAG into an srecode template class.
-STATE is the current compile state as an object `srecode-compile-state'."
-  (require 'srecode/dictionary)
-  (let* ((context (oref STATE context))
-        (codeout  (srecode-compile-split-code
-                   tag (semantic-tag-get-attribute tag :code)
-                   STATE))
-        (code (cdr codeout))
-        (args (semantic-tag-function-arguments tag))
-        (binding (semantic-tag-get-attribute tag :binding))
-        (rawdicts (semantic-tag-get-attribute tag :dictionaries))
-        (sdicts (srecode-create-section-dictionary rawdicts STATE))
-        (addargs nil)
-        )
-;    (message "Compiled %s to %d codes with %d args and %d prompts."
-;           (semantic-tag-name tag)
-;           (length code)
-;           (length args)
-;           (length prompts))
-    (while args
-      (setq addargs (cons (intern (car args)) addargs))
-      (when (eq (car addargs) :blank)
-       ;; If we have a wrap, then put wrap inserters on both
-       ;; ends of the code.
-       (setq code (append
-                   (list (srecode-compile-inserter "BLANK"
-                                                   "\r"
-                                                   STATE
-                                                   :secondname nil
-                                                   :where 'begin))
-                   code
-                   (list (srecode-compile-inserter "BLANK"
-                                                   "\r"
-                                                   STATE
-                                                   :secondname nil
-                                                   :where 'end))
-                         )))
-      (setq args (cdr args)))
+(defun srecode-compile-one-template-tag (tag state)
+  "Compile a template tag TAG into a srecode template object.
+STATE is the current compile state as an object of class
+`srecode-compile-state'."
+  (let* ((context   (oref state context))
+        (code      (cdr (srecode-compile-split-code
+                         tag (semantic-tag-get-attribute tag :code)
+                         state)))
+        (args      (semantic-tag-function-arguments tag))
+        (binding   (semantic-tag-get-attribute tag :binding))
+        (dict-tags (semantic-tag-get-attribute tag :dictionaries))
+        (root-dict (when dict-tags
+                     (srecode-create-dictionaries-from-tags
+                      dict-tags state)))
+        (addargs))
+    ;; Examine arguments.
+    (dolist (arg args)
+      (let ((symbol (intern arg)))
+       (push symbol addargs)
+
+       ;; If we have a wrap, then put wrap inserters on both ends of
+       ;; the code.
+       (when (eq symbol :blank)
+         (setq code (append
+                     (list (srecode-compile-inserter
+                            "BLANK"
+                            "\r"
+                            state
+                            :secondname nil
+                            :where 'begin))
+                     code
+                     (list (srecode-compile-inserter
+                            "BLANK"
+                            "\r"
+                            state
+                            :secondname nil
+                            :where 'end)))))))
+
+    ;; Construct and return the template object.
     (srecode-template (semantic-tag-name tag)
-                     :context context
-                     :args (nreverse addargs)
-                     :dictionary sdicts
-                     :binding binding
-                     :code code)
-    ))
+                     :context    context
+                     :args       (nreverse addargs)
+                     :dictionary root-dict
+                     :binding    binding
+                     :code       code))
+  )
 
 (defun srecode-compile-do-hard-newline-p (comp)
   "Examine COMP to decide if the upcoming newline should be hard.
@@ -368,8 +381,8 @@ It is hard if the previous inserter is a newline object."
   (while (and comp (stringp (car comp)))
     (setq comp (cdr comp)))
   (or (not comp)
-      (require 'srecode/insert)
-      (srecode-template-inserter-newline-child-p (car comp))))
+      (progn (require 'srecode/insert)
+            (srecode-template-inserter-newline-child-p (car comp)))))
 
 (defun srecode-compile-split-code (tag str STATE
                                       &optional end-name)
@@ -514,12 +527,14 @@ to the inserter constructor."
       (if (not new) (error "SRECODE: Unknown macro code %S" key))
       new)))
 
-(defun srecode-compile-template-table (templates mode priority application vars)
+(defun srecode-compile-template-table (templates mode priority application framework project vars)
   "Compile a list of TEMPLATES into an semantic recode table.
 The table being compiled is for MODE, or the string \"default\".
 PRIORITY is a numerical value that indicates this tables location
 in an ordered search.
 APPLICATION is the name of the application these templates belong to.
+FRAMEWORK is the name of the framework these templates belong to.
+PROJECT is a directory name which these templates scope to.
 A list of defined variables VARS provides a variable table."
   (let ((namehash (make-hash-table :test 'equal
                                   :size (length templates)))
@@ -543,12 +558,15 @@ A list of defined variables VARS provides a variable table."
          (when (not hs)
            (setq hs (make-hash-table :test 'equal :size 20))
            (puthash context hs contexthash))
-         ;; Put into that contenxt's hash.
+         ;; Put into that context's hash.
          (puthash objname (car lp) hs)
          )
 
        (setq lp (cdr lp))))
 
+    (when (stringp project)
+      (setq project (expand-file-name project)))
+
     (let* ((table (srecode-mode-table-new mode (buffer-file-name)
                   :templates (nreverse templates)
                   :namehash namehash
@@ -556,7 +574,9 @@ A list of defined variables VARS provides a variable table."
                   :variables vars
                   :major-mode mode
                   :priority priority
-                  :application application))
+                  :application application
+                  :framework framework
+                  :project project))
           (tmpl (oref table templates)))
       ;; Loop over all the templates, and xref.
       (while tmpl
@@ -641,5 +661,4 @@ Argument INDENT specifies the indentation level for the list."
 ;; generated-autoload-load-name: "srecode/compile"
 ;; End:
 
-;; arch-tag: d993ffab-2704-4bb2-bd92-eafe803af3be
 ;;; srecode/compile.el ends here