+(defun vhdl-compose-configuration-architecture (ent-name arch-name inst-alist
+ &optional insert-conf)
+ "Generate block configuration for architecture."
+ (let ((margin (current-indentation))
+ (beg (save-excursion (beginning-of-line) (point)))
+ ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist)
+ ;; insert block configuration (for architecture)
+ (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
+ (setq margin (+ margin vhdl-basic-offset))
+ ;; process all instances
+ (while inst-alist
+ (setq inst-entry (car inst-alist))
+ ;; is component?
+ (when (nth 4 inst-entry)
+ (setq insert-conf t)
+ (setq inst-path (nth 9 inst-entry))
+ ;; skip common path with previous instance
+ (while (and inst-path (equal (car inst-path) (car inst-prev-path)))
+ (setq inst-path (cdr inst-path)
+ inst-prev-path (cdr inst-prev-path)))
+ ;; insert block configuration end (for previous block/generate)
+ (while inst-prev-path
+ (setq margin (- margin vhdl-basic-offset))
+ (indent-to margin)
+ (vhdl-insert-keyword "END FOR;\n")
+ (setq inst-prev-path (cdr inst-prev-path)))
+ ;; insert block configuration beginning (for current block/generate)
+ (indent-to margin)
+ (while inst-path
+ (setq margin (+ margin vhdl-basic-offset))
+ (vhdl-insert-keyword "FOR ")
+ (insert (car inst-path) "\n")
+ (indent-to margin)
+ (setq inst-path (cdr inst-path)))
+ ;; insert component configuration beginning
+ (vhdl-insert-keyword "FOR ")
+ (insert (nth 1 inst-entry) " : " (nth 4 inst-entry) "\n")
+ ;; find subconfiguration
+ (setq conf-key (nth 7 inst-entry))
+ (setq tmp-alist conf-alist)
+ ;; use first configuration found for instance's entity
+ (while (and tmp-alist (null conf-key))
+ (when (equal (nth 5 inst-entry) (nth 4 (car tmp-alist)))
+ (setq conf-key (nth 0 (car tmp-alist))))
+ (setq tmp-alist (cdr tmp-alist)))
+ (setq conf-entry (aget conf-alist conf-key t))
+ ;; insert binding indication ...
+ ;; ... with subconfiguration (if exists)
+ (if (and vhdl-compose-configuration-use-subconfiguration conf-entry)
+ (progn
+ (indent-to (+ margin vhdl-basic-offset))
+ (vhdl-insert-keyword "USE CONFIGURATION ")
+ (insert (vhdl-work-library) "." (nth 0 conf-entry))
+ (insert ";\n"))
+ ;; ... with entity (if exists)
+ (setq ent-entry (aget ent-alist (nth 5 inst-entry) t))
+ (when ent-entry
+ (indent-to (+ margin vhdl-basic-offset))
+ (vhdl-insert-keyword "USE ENTITY ")
+ (insert (vhdl-work-library) "." (nth 0 ent-entry))
+ ;; insert architecture name (if architecture exists)
+ (when (nth 3 ent-entry)
+ (setq arch-name
+ ;; choose architecture name a) from configuration,
+ ;; b) from mra, or c) from first architecture
+ (or (nth 0 (aget (nth 3 ent-entry)
+ (or (nth 6 inst-entry)
+ (nth 4 ent-entry)) t))
+ (nth 1 (car (nth 3 ent-entry)))))
+ (insert "(" arch-name ")"))
+ (insert ";\n")
+ ;; insert block configuration (for architecture of subcomponent)
+ (when (and vhdl-compose-configuration-hierarchical
+ (nth 3 ent-entry))
+ (indent-to (+ margin vhdl-basic-offset))
+ (vhdl-compose-configuration-architecture
+ (nth 0 ent-entry) arch-name
+ (nth 3 (aget (nth 3 ent-entry) (downcase arch-name) t))))))
+ ;; insert component configuration end
+ (indent-to margin)
+ (vhdl-insert-keyword "END FOR;\n")
+ (setq inst-prev-path (nth 9 inst-entry)))
+ (setq inst-alist (cdr inst-alist)))
+ ;; insert block configuration end (for block/generate)
+ (while inst-prev-path
+ (setq margin (- margin vhdl-basic-offset))
+ (indent-to margin)
+ (vhdl-insert-keyword "END FOR;\n")
+ (setq inst-prev-path (cdr inst-prev-path)))
+ (indent-to (- margin vhdl-basic-offset))
+ ;; insert block configuration end or remove beginning (for architecture)
+ (if insert-conf
+ (vhdl-insert-keyword "END FOR;\n")
+ (delete-region beg (point)))))
+
+(defun vhdl-compose-configuration (&optional ent-name arch-name)
+ "Generate configuration declaration."
+ (interactive)
+ (vhdl-require-hierarchy-info)
+ (let ((ent-alist (aget vhdl-entity-alist
+ (or (vhdl-project-p) default-directory) t))
+ (conf-alist (aget vhdl-config-alist
+ (or (vhdl-project-p) default-directory) t))
+ (from-speedbar ent-name)
+ inst-alist conf-name conf-file-name pos)
+ (vhdl-prepare-search-2
+ ;; get entity and architecture name
+ (unless ent-name
+ (save-excursion
+ (unless (and (re-search-backward "^\\(architecture\\s-+\\(\\w+\\)\\s-+of\\s-+\\(\\w+\\)\\|end\\)\\>" nil t)
+ (not (equal "END" (upcase (match-string 1))))
+ (setq ent-name (match-string-no-properties 3))
+ (setq arch-name (match-string-no-properties 2)))
+ (error "ERROR: Not within an architecture"))))
+ (setq conf-name (vhdl-replace-string
+ vhdl-compose-configuration-name
+ (concat ent-name " " arch-name)))
+ (setq inst-alist
+ (nth 3 (aget (nth 3 (aget ent-alist (downcase ent-name) t))
+ (downcase arch-name) t))))
+ (message "Generating configuration \"%s\"..." conf-name)
+ (if vhdl-compose-configuration-create-file
+ ;; open configuration file
+ (progn
+ (setq conf-file-name
+ (concat (vhdl-replace-string vhdl-configuration-file-name
+ conf-name t)
+ "." (file-name-extension (buffer-file-name))))
+ (when (and (file-exists-p conf-file-name)
+ (not (y-or-n-p (concat "File \"" conf-file-name
+ "\" exists; overwrite? "))))
+ (error "ERROR: Creating configuration...aborted"))
+ (find-file conf-file-name)
+ (erase-buffer)
+ (set-buffer-modified-p nil)
+ ;; insert header
+ (if vhdl-compose-include-header
+ (progn (vhdl-template-header
+ (concat "Configuration declaration for design \""
+ ent-name "(" arch-name ")\""))
+ (goto-char (point-max)))
+ (vhdl-comment-display-line) (insert "\n\n")))
+ ;; goto end of architecture
+ (unless from-speedbar
+ (re-search-forward "^end\\>" nil)
+ (end-of-line) (insert "\n\n")
+ (vhdl-comment-display-line) (insert "\n\n")))
+ ;; insert library clause
+ (setq pos (point))
+ (vhdl-template-standard-package (vhdl-work-library) nil)
+ (when (/= pos (point))
+ (insert "\n\n"))
+ ;; insert configuration
+ (vhdl-insert-keyword "CONFIGURATION ") (insert conf-name)
+ (vhdl-insert-keyword " OF ") (insert ent-name)
+ (vhdl-insert-keyword " IS\n")
+ (indent-to vhdl-basic-offset)
+ ;; insert block configuration (for architecture)
+ (vhdl-compose-configuration-architecture ent-name arch-name inst-alist t)
+ (vhdl-insert-keyword "END ") (insert conf-name ";")
+ (when conf-file-name
+ ;; insert footer and save
+ (insert "\n\n")
+ (if (and vhdl-compose-include-header (not (equal vhdl-file-footer "")))
+ (vhdl-template-footer)
+ (vhdl-comment-display-line) (insert "\n"))
+ (save-buffer))
+ (message "%s"
+ (concat (format "Generating configuration \"%s\"...done" conf-name)
+ (and conf-file-name
+ (format "\n File created: \"%s\"" conf-file-name))))))
+