diff lisp/cedet/srecode/dictionary.el @ 104498:41dc39934483

lisp/cedet/srecode.el: lisp/cedet/srecode/*.el: test/cedet/srecode-tests.el: New files lisp/files.el (auto-mode-alist): Use srecode-template-mode for .srt files. lisp/cedet/semantic/bovine/scm.el: Add local vars section for autoloading.

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/cedet/srecode/dictionary.el	Sun Sep 20 21:06:41 2009 +0000
@@ -0,0 +1,565 @@
+;;; srecode-dictionary.el --- Dictionary code for the semantic recoder.
+
+;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+
+;; Author: Eric M. Ludlam <[e-mail]>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Dictionaries contain lists of names and their assocaited values.
+;; These dictionaries are used to fill in macros from recoder templates.
+
+;;; Code:
+
+;;; CLASSES
+
+(require 'eieio)
+(require 'srecode)
+(require 'srecode/table)
+(eval-when-compile (require 'semantic))
+
+(declare-function srecode-compile-parse-inserter "srecode/compile")
+(declare-function srecode-dump-code-list "srecode/compile")
+(declare-function srecode-load-tables-for-mode "srecode/find")
+(declare-function srecode-insert-code-stream "srecode/insert")
+(declare-function data-debug-new-buffer "data-debug")
+(declare-function data-debug-insert-object-slots "eieio-datadebug")
+(declare-function srecode-field "srecode/fields")
+
+(defclass srecode-dictionary ()
+  ((namehash :initarg :namehash
+	     :documentation
+	     "Hash table containing the names of all the templates.")
+   (buffer :initarg :buffer
+	   :documentation
+	   "The buffer this dictionary was initialized with.")
+   (parent :initarg :parent
+	   :type (or null srecode-dictionary)
+	   :documentation
+	   "The parent dictionary.
+Symbols not appearing in this dictionary will be checked against the
+parent dictionary.")
+   (origin :initarg :origin
+	   :type string
+	   :documentation
+	   "A string representing the origin of this dictionary.
+Useful only while debugging.")
+   )
+  "Dictionary of symbols and what they mean.
+Dictionaries are used to look up named symbols from
+templates to decide what to do with those symbols.")
+
+(defclass srecode-dictionary-compound-value ()
+  ()
+  "A compound dictionary value.
+Values stored in a dictionary must be a STRING,
+a dictionary for showing sections, or an instance of a subclass
+of this class.
+
+Compound dictionary values derive from this class, and must
+provide a sequence of method implementations to convert into
+a string."
+  :abstract t)
+
+(defclass srecode-dictionary-compound-variable
+  (srecode-dictionary-compound-value)
+  ((value :initarg :value
+	  :documentation
+	  "The value of this template variable.
+Variables in template files are usually a single string
+which can be inserted into a dictionary directly.
+
+Some variables may be more complex and involve dictionary
+lookups, strings, concatenation, or the like.
+
+The format of VALUE is determined by current template
+formatting rules.")
+   (compiled :initarg :compiled
+	     :type list
+	     :documentation
+	     "The compiled version of VALUE.")
+   )
+  "A compound dictionary value for template file variables.
+You can declare a variable in a template like this:
+
+set NAME \"str\" macro \"OTHERNAME\"
+
+with appending various parts together in a list.")
+
+(defmethod initialize-instance ((this srecode-dictionary-compound-variable)
+				&optional fields)
+  "Initialize the compound variable THIS.
+Makes sure that :value is compiled."
+  (let ((newfields nil)
+	(state nil))
+    (while fields
+      ;; Strip out :state
+      (if (eq (car fields) :state)
+	  (setq state (car (cdr fields)))
+	(setq newfields (cons (car (cdr fields))
+			      (cons (car fields) newfields))))
+      (setq fields (cdr (cdr fields))))
+
+    (when (not state)
+      (error "Cannot create compound variable without :state"))
+
+    (call-next-method this (nreverse newfields))
+    (when (not (slot-boundp this 'compiled))
+      (let ((val (oref this :value))
+	    (comp nil))
+	(while val
+	  (let ((nval (car val))
+		)
+	    (cond ((stringp nval)
+		   (setq comp (cons nval comp)))
+		  ((and (listp nval)
+			(equal (car nval) 'macro))
+		   (require 'srecode/compile)
+		   (setq comp (cons
+			       (srecode-compile-parse-inserter
+				(cdr nval)
+				state)
+			       comp)))
+		  (t
+		   (error "Don't know how to handle variable value %S" nval)))
+	    )
+	  (setq val (cdr val)))
+	(oset this :compiled (nreverse comp))))))
+
+;;; DICTIONARY METHODS
+;;
+
+(defun srecode-create-dictionary (&optional buffer-or-parent)
+  "Create a dictionary for BUFFER.
+If BUFFER-OR-PARENT is not specified, assume a buffer, and
+use the current buffer.
+If BUFFER-OR-PARENT is another dictionary, then remember the
+parent within the new dictionary, and assume that BUFFER
+is the same as belongs to the parent dictionary.
+The dictionary is initialized with variables setup for that
+buffer's table.
+If BUFFER-OR-PARENT is t, then this dictionary should not be
+assocated with a buffer or parent."
+  (save-excursion
+    (let ((parent nil)
+	  (buffer nil)
+	  (origin nil)
+	  (initfrombuff nil))
+      (cond ((bufferp buffer-or-parent)
+	     (set-buffer buffer-or-parent)
+	     (setq buffer buffer-or-parent
+		   origin (buffer-name buffer-or-parent)
+		   initfrombuff t))
+	    ((srecode-dictionary-child-p buffer-or-parent)
+	     (setq parent buffer-or-parent
+		   buffer (oref buffer-or-parent buffer)
+		   origin (concat (object-name buffer-or-parent) " in "
+				  (if buffer (buffer-name buffer)
+				    "no buffer")))
+	     (when buffer
+	       (set-buffer buffer)))
+	    ((eq buffer-or-parent t)
+	     (setq buffer nil
+		   origin "Unspecified Origin"))
+	    (t
+	     (setq buffer (current-buffer)
+		   origin (concat "Unspecified.  Assume "
+				  (buffer-name buffer))
+		   initfrombuff t)
+	     )
+	    )
+      (let ((dict (srecode-dictionary
+		   major-mode
+		   :buffer buffer
+		   :parent parent
+		   :namehash  (make-hash-table :test 'equal
+					       :size 20)
+		   :origin origin)))
+	;; Only set up the default variables if we are being built
+	;; directroy for a particular buffer.
+	(when initfrombuff
+	  ;; Variables from the table we are inserting from.
+	  ;; @todo - get a better tree of tables.
+	  (let ((mt (srecode-get-mode-table major-mode))
+		(def (srecode-get-mode-table 'default)))
+	    ;; Each table has multiple template tables.
+	    ;; Do DEF first so that MT can override any values.
+	    (srecode-dictionary-add-template-table dict def)
+	    (srecode-dictionary-add-template-table dict mt)
+	    ))
+	dict))))
+
+(defmethod srecode-dictionary-add-template-table ((dict srecode-dictionary)
+						  tpl)
+  "Insert into DICT the variables found in table TPL.
+TPL is an object representing a compiled template file."
+  (when tpl
+    (let ((tabs (oref tpl :tables)))
+      (while tabs
+	(let ((vars (oref (car tabs) variables)))
+	  (while vars
+	    (srecode-dictionary-set-value
+	     dict (car (car vars)) (cdr (car vars)))
+	    (setq vars (cdr vars))))
+	(setq tabs (cdr tabs))))))
+
+
+(defmethod srecode-dictionary-set-value ((dict srecode-dictionary)
+					 name value)
+  "In dictionary DICT, set NAME to have VALUE."
+  ;; Validate inputs
+  (if (not (stringp name))
+      (signal 'wrong-type-argument (list name 'stringp)))
+  ;; Add the value.
+  (with-slots (namehash) dict
+    (puthash name value namehash))
+  )
+
+(defmethod srecode-dictionary-add-section-dictionary ((dict srecode-dictionary)
+						      name &optional show-only)
+  "In dictionary DICT, add a section dictionary for section macro NAME.
+Return the new dictionary.
+
+You can add several dictionaries to the same section macro.
+For each dictionary added to a macro, the block of codes in the
+template will be repeated.
+
+If optional argument SHOW-ONLY is non-nil, then don't add a new dictionarly
+if there is already one in place.  Also, don't add FIRST/LAST entries.
+These entries are not needed when we are just showing a section.
+
+Each dictionary added will automatically get values for positional macros
+which will enable SECTIONS to be enabled.
+
+ * FIRST - The first entry in the table.
+ * NOTFIRST - Not the first entry in the table.
+ * LAST - The last entry in the table
+ * NOTLAST - Not the last entry in the table.
+
+Adding a new dictionary will alter these values in previously
+inserted dictionaries."
+  ;; Validate inputs
+  (if (not (stringp name))
+      (signal 'wrong-type-argument (list name 'stringp)))
+  (let ((new (srecode-create-dictionary dict))
+	(ov (srecode-dictionary-lookup-name dict name)))
+
+    (when (not show-only)
+      ;; Setup the FIRST/NOTFIRST and LAST/NOTLAST entries.
+      (if (null ov)
+	  (progn
+	    (srecode-dictionary-show-section new "FIRST")
+	    (srecode-dictionary-show-section new "LAST"))
+	;; Not the very first one.  Lets clean up CAR.
+	(let ((tail (car (last ov))))
+	  (srecode-dictionary-hide-section tail "LAST")
+	  (srecode-dictionary-show-section tail "NOTLAST")
+	  )
+	(srecode-dictionary-show-section new "NOTFIRST")
+	(srecode-dictionary-show-section new "LAST"))
+      )
+
+    (when (or (not show-only) (null ov))
+      (srecode-dictionary-set-value dict name (append ov (list new))))
+    ;; Return the new sub-dictionary.
+    new))
+
+(defmethod srecode-dictionary-show-section ((dict srecode-dictionary) name)
+  "In dictionary DICT, indicate that the section NAME should be exposed."
+  ;; Validate inputs
+  (if (not (stringp name))
+      (signal 'wrong-type-argument (list name 'stringp)))
+  ;; Showing a section is just like making a section dictionary, but
+  ;; with no dictionary values to add.
+  (srecode-dictionary-add-section-dictionary dict name t)
+  nil)
+
+(defmethod srecode-dictionary-hide-section ((dict srecode-dictionary) name)
+  "In dictionary DICT, indicate that the section NAME should be hidden."
+  ;; We need to find the has value, and then delete it.
+  ;; Validate inputs
+  (if (not (stringp name))
+      (signal 'wrong-type-argument (list name 'stringp)))
+  ;; Add the value.
+  (with-slots (namehash) dict
+    (remhash name namehash))
+  nil)
+
+(defmethod srecode-dictionary-merge ((dict srecode-dictionary) otherdict)
+  "Merge into DICT the dictionary entries from OTHERDICT."
+  (when otherdict
+    (maphash
+     (lambda (key entry)
+       ;; Only merge in the new values if there was no old value.
+       ;; This protects applications from being whacked, and basically
+       ;; makes these new section dictionary entries act like
+       ;; "defaults" instead of overrides.
+       (when (not (srecode-dictionary-lookup-name dict key))
+	 (cond ((and (listp entry) (srecode-dictionary-p (car entry)))
+		;; A list of section dictionaries.
+		;; We need to merge them in.
+		(while entry
+		  (let ((new-sub-dict
+			 (srecode-dictionary-add-section-dictionary
+			  dict key)))
+		    (srecode-dictionary-merge new-sub-dict (car entry)))
+		  (setq entry (cdr entry)))
+		  )
+
+	       (t
+		(srecode-dictionary-set-value dict key entry)))
+	       ))
+     (oref otherdict namehash))))
+
+(defmethod srecode-dictionary-lookup-name ((dict srecode-dictionary)
+					   name)
+  "Return information about the current DICT's value for NAME."
+  (if (not (slot-boundp dict 'namehash))
+      nil
+    ;; Get the value of this name from the dictionary
+    (or (with-slots (namehash) dict
+	  (gethash name namehash))
+	(and (not (member name '("FIRST" "LAST" "NOTFIRST" "NOTLAST")))
+	     (oref dict parent)
+	     (srecode-dictionary-lookup-name (oref dict parent) name))
+	)))
+
+(defmethod srecode-root-dictionary ((dict srecode-dictionary))
+  "For dictionary DICT, return the root dictionary.
+The root dictionary is usually for a current or active insertion."
+  (let ((ans dict))
+    (while (oref ans parent)
+      (setq ans (oref ans parent)))
+    ans))
+
+;;; COMPOUND VALUE METHODS
+;;
+;; Compound values must provide at least the toStriong method
+;; for use in converting the compound value into sometehing insertable.
+
+(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-value)
+				      function
+				      dictionary)
+  "Convert the compound dictionary value CP to a string.
+If FUNCTION is non-nil, then FUNCTION is somehow applied to an aspect
+of the compound value.  The FUNCTION could be a fraction
+of some function symbol with a logical prefix excluded.
+
+If you subclass `srecode-dictionary-compound-value' then this
+method could return nil, but if it does that, it must insert
+the value itself using `princ', or by detecting if the current
+standard out is a buffer, and using `insert'."
+  (object-name cp))
+
+(defmethod srecode-dump ((cp srecode-dictionary-compound-value)
+			 &optional indent)
+  "Display information about this compound value."
+  (princ (object-name cp))
+  )
+
+(defmethod srecode-compound-toString ((cp srecode-dictionary-compound-variable)
+				      function
+				      dictionary)
+  "Convert the compound dictionary variable value CP into a string.
+FUNCTION and DICTIONARY are as for the baseclass."
+  (require 'srecode/insert)
+  (srecode-insert-code-stream (oref cp compiled) dictionary))
+
+
+(defmethod srecode-dump ((cp srecode-dictionary-compound-variable)
+			 &optional indent)
+  "Display information about this compound value."
+  (require 'srecode/compile)
+  (princ "# Compound Variable #\n")
+  (let ((indent (+ 4 (or indent 0)))
+	(cmp (oref cp compiled))
+	)
+    (srecode-dump-code-list cmp (make-string indent ? ))
+    ))
+
+;;; FIELD EDITING COMPOUND VALUE
+;;
+;; This is an interface to using field-editing objects
+;; instead of asking questions.  This provides the basics
+;; behind this compound value.
+
+(defclass srecode-field-value (srecode-dictionary-compound-value)
+  ((firstinserter :initarg :firstinserter
+		  :documentation
+		  "The inserter object for the first occurance of this field.")
+   (defaultvalue :initarg :defaultvalue
+     :documentation
+     "The default value for this inserter.")
+   )
+  "When inserting values with editable field mode, a dictionary value.
+Compound values allow a field to be stored in the dictionary for when
+it is referenced a second time.  This compound value can then be
+inserted with a new editable field.")
+
+(defmethod srecode-compound-toString((cp srecode-field-value)
+				     function
+				     dictionary)
+  "Convert this field into an insertable string."
+  (require 'srecode/fields)
+  ;; If we are not in a buffer, then this is not supported.
+  (when (not (bufferp standard-output))
+    (error "FIELDS invoked while inserting template to non-buffer."))
+
+  (if function
+      (error "@todo: Cannot mix field insertion with functions.")
+
+    ;; No function.  Perform a plain field insertion.
+    ;; We know we are in a buffer, so we can perform the insertion.
+    (let* ((dv (oref cp defaultvalue))
+	   (sti (oref cp firstinserter))
+	   (start (point))
+	   (name (oref sti :object-name)))
+
+      (if (or (not dv) (string= dv ""))
+	  (insert name)
+	(insert dv))
+
+      (srecode-field name :name name
+		     :start start
+		     :end (point)
+		     :prompt (oref sti prompt)
+		     :read-fcn (oref sti read-fcn)
+		     )
+      ))
+  ;; Returning nil is a signal that we have done the insertion ourselves.
+  nil)
+
+
+;;; Higher level dictionary functions
+;;
+(defun srecode-create-section-dictionary (sectiondicts STATE)
+  "Create a dictionary with section entries for a template.
+The format for SECTIONDICTS is what is emitted from the template parsers.
+STATE is the current compiler state."
+  (when sectiondicts
+    (let ((new (srecode-create-dictionary t)))
+      ;; Loop over each section.  The section is a macro w/in the
+      ;; template.
+      (while sectiondicts
+	(let* ((sect (car (car sectiondicts)))
+	       (entries (cdr (car sectiondicts)))
+	       (subdict (srecode-dictionary-add-section-dictionary new sect))
+	       )
+	  ;; Loop over each entry.  This is one variable in the
+	  ;; section dictionary.
+	  (while entries
+	    (let ((tname (semantic-tag-name (car entries)))
+		  (val (semantic-tag-variable-default (car entries))))
+	      (if (eq val t)
+		  (srecode-dictionary-show-section subdict tname)
+		(cond
+		 ((and (stringp (car val))
+		       (= (length val) 1))
+		  (setq val (car val)))
+		 (t
+		  (setq val (srecode-dictionary-compound-variable
+			     tname :value val :state STATE))))
+		(srecode-dictionary-set-value
+		 subdict tname val))
+	      (setq entries (cdr entries))))
+	  )
+	(setq sectiondicts (cdr sectiondicts)))
+      new)))
+
+;;; DUMP DICTIONARY
+;;
+;; Make a dictionary, and dump it's contents.
+
+(defun srecode-adebug-dictionary ()
+  "Run data-debug on this mode's dictionary."
+  (interactive)
+  (require 'eieio-datadebug)
+  (require 'semantic)
+  (require 'srecode/find)
+  (let* ((modesym major-mode)
+	 (start (current-time))
+	 (junk (or (progn (srecode-load-tables-for-mode modesym)
+			  (srecode-get-mode-table modesym))
+		   (error "No table found for mode %S" modesym)))
+	 (dict (srecode-create-dictionary (current-buffer)))
+	 (end (current-time))
+	 )
+    (message "Creating a dictionary took %.2f seconds."
+	     (semantic-elapsed-time start end))
+    (data-debug-new-buffer "*SRECODE ADEBUG*")
+    (data-debug-insert-object-slots dict "*")))
+
+(defun srecode-dictionary-dump ()
+  "Dump a typical fabricated dictionary."
+  (interactive)
+  (require 'srecode/find)
+  (let ((modesym major-mode))
+    ;; This load allows the dictionary access to inherited
+    ;; and stacked dictionary entries.
+    (srecode-load-tables-for-mode modesym)
+    (let ((tmp (srecode-get-mode-table modesym))
+	  )
+      (if (not tmp)
+	  (error "No table found for mode %S" modesym))
+      ;; Now make the dictionary.
+      (let ((dict (srecode-create-dictionary (current-buffer))))
+	(with-output-to-temp-buffer "*SRECODE DUMP*"
+	  (princ "DICTIONARY FOR ")
+	  (princ major-mode)
+	  (princ "\n--------------------------------------------\n")
+	  (srecode-dump dict))
+	))))
+
+(defmethod srecode-dump ((dict srecode-dictionary) &optional indent)
+  "Dump a dictionary."
+  (if (not indent) (setq indent 0))
+  (maphash (lambda (key entry)
+	     (princ (make-string indent ? ))
+	     (princ " ")
+	     (princ key)
+	     (princ " ")
+	     (cond ((and (listp entry)
+			 (srecode-dictionary-p (car entry)))
+		    (let ((newindent (if indent
+					 (+ indent 4)
+				       4)))
+		      (while entry
+			(princ " --> SUBDICTIONARY ")
+			(princ (object-name dict))
+			(princ "\n")
+			(srecode-dump (car entry) newindent)
+			(setq entry (cdr entry))
+			))
+		    (princ "\n")
+		    )
+		   ((srecode-dictionary-compound-value-child-p entry)
+		    (srecode-dump entry indent)
+		    (princ "\n")
+		    )
+		   (t
+		    (prin1 entry)
+		    ;(princ "\n")
+		    ))
+	     (terpri)
+	     )
+	   (oref dict namehash))
+  )
+
+(provide 'srecode/dictionary)
+
+;;; srecode/dictionary.el ends here