Function: vhdl-compose-wire-components
vhdl-compose-wire-components is an interactive and byte-compiled
function defined in vhdl-mode.el.gz.
Signature
(vhdl-compose-wire-components)
Documentation
Connect components.
Key Bindings
Source Code
;; Defined in /usr/src/emacs/lisp/progmodes/vhdl-mode.el.gz
(defun vhdl-compose-wire-components ()
"Connect components."
(interactive)
(save-excursion
(vhdl-prepare-search-2
(unless (or (re-search-backward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t)
(re-search-forward "^architecture[ \t\n\r\f]+\\w+[ \t\n\r\f]+of[ \t\n\r\f]+\\(\\w+\\)[ \t\n\r\f]+is\\>" nil t))
(error "ERROR: No architecture found"))
(let* ((ent-name (match-string 1))
(ent-file-name
(concat (vhdl-replace-string vhdl-entity-file-name ent-name t)
"." (file-name-extension (buffer-file-name))))
(arch-decl-pos (point-marker))
(arch-stat-pos (re-search-forward "^begin\\>" nil))
(arch-end-pos (re-search-forward "^end\\>" nil))
(pack-name (vhdl-get-components-package-name))
(pack-file-name
(concat (vhdl-replace-string vhdl-package-file-name pack-name t)
"." (file-name-extension (buffer-file-name))))
inst-name comp-name comp-ent-name comp-ent-file-name has-generic
port-alist generic-alist inst-alist
signal-name signal-entry signal-alist local-list written-list
single-in-list multi-in-list single-out-list multi-out-list
constant-name constant-entry constant-alist single-list multi-list
port-beg-pos port-in-pos port-out-pos port-inst-pos port-end-pos
generic-beg-pos generic-pos generic-inst-pos generic-end-pos
signal-beg-pos signal-pos
constant-temp-pos port-temp-pos signal-temp-pos)
(message "Wiring components...")
;; process all instances
(goto-char arch-stat-pos)
(while (re-search-forward
(concat "^[ \t]*\\(\\w+\\)[ \t\n\r\f]*:[ \t\n\r\f]*\\("
"\\(component[ \t\n\r\f]+\\)?\\(\\w+\\)"
"[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\|"
"\\(\\(entity\\)\\|configuration\\)[ \t\n\r\f]+\\(\\(\\w+\\)\\.\\)?\\(\\w+\\)\\([ \t\n\r\f]*(\\(\\w+\\))\\)?"
"[ \t\n\r\f]+\\(--[^\n]*\n[ \t\n\r\f]*\\)*\\(\\(generic\\)\\|port\\)[ \t\n\r\f]+map\\)[ \t\n\r\f]*(") arch-end-pos t)
(setq inst-name (match-string-no-properties 1)
comp-name (match-string-no-properties 4)
comp-ent-name (match-string-no-properties 12)
has-generic (or (match-string 7) (match-string 17)))
;; get port ...
(if comp-name
;; ... from component declaration
(vhdl-visit-file
(when vhdl-use-components-package pack-file-name) t
(save-excursion
(goto-char (point-min))
(unless (re-search-forward (concat "^\\s-*component[ \t\n\r\f]+" comp-name "\\>") nil t)
(error "ERROR: Component declaration not found: \"%s\"" comp-name))
(vhdl-port-copy)))
;; ... from entity declaration (direct instantiation)
(setq comp-ent-file-name
(concat (vhdl-replace-string vhdl-entity-file-name comp-ent-name t)
"." (file-name-extension (buffer-file-name))))
(vhdl-visit-file
comp-ent-file-name t
(save-excursion
(goto-char (point-min))
(unless (re-search-forward (concat "^\\s-*entity[ \t\n\r\f]+" comp-ent-name "\\>") nil t)
(error "ERROR: Entity declaration not found: \"%s\"" comp-ent-name))
(vhdl-port-copy))))
(vhdl-port-flatten t)
(setq generic-alist (nth 1 vhdl-port-list)
port-alist (nth 2 vhdl-port-list)
vhdl-port-list nil)
(setq constant-alist nil
signal-alist nil)
(when has-generic
;; process all constants in generic map
(vhdl-forward-syntactic-ws)
(while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
(setq constant-name (match-string-no-properties 3))
(setq constant-entry
(cons constant-name
(if (match-string 1)
(or (vhdl-aget generic-alist (match-string 2))
(error "ERROR: Formal generic \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
(cdar generic-alist))))
(push constant-entry constant-alist)
(setq constant-name (downcase constant-name))
(if (or (member constant-name single-list)
(member constant-name multi-list))
(progn (setq single-list (delete constant-name single-list))
(vhdl--pushnew constant-name multi-list :test #'equal))
(vhdl--pushnew constant-name single-list :test #'equal))
(unless (match-string 1)
(setq generic-alist (cdr generic-alist)))
(vhdl-forward-syntactic-ws))
(vhdl-re-search-forward "\\<port\\s-+map[ \t\n\r\f]*(" nil t))
;; process all signals in port map
(vhdl-forward-syntactic-ws)
(while (vhdl-parse-string "\\(\\(\\w+\\)[ \t\n\r\f]*=>[ \t\n\r\f]*\\)?\\(\\w+\\),?" t)
(setq signal-name (match-string-no-properties 3))
(setq signal-entry
(cons signal-name
(if (match-string 1)
(or (vhdl-aget port-alist (match-string 2))
(error "ERROR: Formal port \"%s\" mismatch for instance \"%s\"" (match-string 2) inst-name))
(cdar port-alist))))
(push signal-entry signal-alist)
(setq signal-name (downcase signal-name))
(if (equal (upcase (nth 2 signal-entry)) "IN")
;; input signal
(cond
((member signal-name local-list)
nil)
((or (member signal-name single-out-list)
(member signal-name multi-out-list))
(setq single-out-list (delete signal-name single-out-list))
(setq multi-out-list (delete signal-name multi-out-list))
(vhdl--pushnew signal-name local-list :test #'equal))
((member signal-name single-in-list)
(setq single-in-list (delete signal-name single-in-list))
(vhdl--pushnew signal-name multi-in-list :test #'equal))
((not (member signal-name multi-in-list))
(vhdl--pushnew signal-name single-in-list :test #'equal)))
;; output signal
(cond
((member signal-name local-list)
nil)
((or (member signal-name single-in-list)
(member signal-name multi-in-list))
(setq single-in-list (delete signal-name single-in-list))
(setq multi-in-list (delete signal-name multi-in-list))
(vhdl--pushnew signal-name local-list :test #'equal))
((member signal-name single-out-list)
(setq single-out-list (delete signal-name single-out-list))
(vhdl--pushnew signal-name multi-out-list :test #'equal))
((not (member signal-name multi-out-list))
(vhdl--pushnew signal-name single-out-list :test #'equal))))
(unless (match-string 1)
(setq port-alist (cdr port-alist)))
(vhdl-forward-syntactic-ws))
(push (list inst-name (nreverse constant-alist)
(nreverse signal-alist))
inst-alist))
;; prepare signal insertion
(vhdl-goto-marker arch-decl-pos)
(forward-line 1)
(re-search-forward "^\\s-*-- Internal signal declarations[ \t\n\r\f]*-*\n" arch-stat-pos t)
(setq signal-pos (point-marker))
(while (progn (vhdl-forward-syntactic-ws)
(looking-at "signal\\>"))
(beginning-of-line 2)
(delete-region signal-pos (point)))
(setq signal-beg-pos signal-pos)
;; open entity file
(when (file-exists-p ent-file-name)
(find-file ent-file-name))
(goto-char (point-min))
(unless (re-search-forward (concat "^entity[ \t\n\r\f]+" ent-name "[ \t\n\r\f]+is\\>") nil t)
(error "ERROR: Entity not found: \"%s\"" ent-name))
;; prepare generic clause insertion
(unless (and (re-search-forward "\\(^\\s-*generic[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
(match-string 1))
(goto-char (match-beginning 0))
(indent-to vhdl-basic-offset)
(insert "generic ();\n\n")
(backward-char 4))
(backward-char)
(setq generic-pos (point-marker))
(forward-sexp) (end-of-line)
(delete-region generic-pos (point)) (delete-char 1)
(insert "(\n")
(when multi-list
(insert "\n")
(indent-to (* 2 vhdl-basic-offset))
(insert "-- global generics\n"))
(setq generic-beg-pos (point-marker) generic-pos (point-marker)
generic-inst-pos (point-marker) generic-end-pos (point-marker))
;; prepare port clause insertion
(unless (and (re-search-forward "\\(^\\s-*port[ \t\n\r\f]*(\\)\\|^end\\>" nil t)
(match-string 1))
(goto-char (match-beginning 0))
(indent-to vhdl-basic-offset)
(insert "port ();\n\n")
(backward-char 4))
(backward-char)
(setq port-in-pos (point-marker))
(forward-sexp) (end-of-line)
(delete-region port-in-pos (point)) (delete-char 1)
(insert "(\n")
(when (or multi-in-list multi-out-list)
(insert "\n")
(indent-to (* 2 vhdl-basic-offset))
(insert "-- global ports\n"))
(setq port-beg-pos (point-marker) port-in-pos (point-marker)
port-out-pos (point-marker) port-inst-pos (point-marker)
port-end-pos (point-marker))
;; insert generics, ports and signals
(setq inst-alist (nreverse inst-alist))
(while inst-alist
(setq inst-name (nth 0 (car inst-alist))
constant-alist (nth 1 (car inst-alist))
signal-alist (nth 2 (car inst-alist))
constant-temp-pos generic-inst-pos
port-temp-pos port-inst-pos
signal-temp-pos signal-pos)
;; generics
(while constant-alist
(setq constant-name (downcase (caar constant-alist))
constant-entry (car constant-alist))
(unless (string-match "^[0-9]+" constant-name)
(cond ((member constant-name written-list)
nil)
((member constant-name multi-list)
(vhdl-goto-marker generic-pos)
(setq generic-end-pos
(vhdl-max-marker
generic-end-pos
(vhdl-compose-insert-generic constant-entry)))
(setq generic-pos (point-marker))
(vhdl--pushnew constant-name written-list :test #'equal))
(t
(vhdl-goto-marker
(vhdl-max-marker generic-inst-pos generic-pos))
(setq generic-end-pos
(vhdl-compose-insert-generic constant-entry))
(setq generic-inst-pos (point-marker))
(vhdl--pushnew constant-name written-list :test #'equal))))
(setq constant-alist (cdr constant-alist)))
(when (/= constant-temp-pos generic-inst-pos)
(vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos))
(insert "\n") (indent-to (* 2 vhdl-basic-offset))
(insert "-- generics for \"" inst-name "\"\n")
(vhdl-goto-marker generic-inst-pos))
;; ports and signals
(while signal-alist
(setq signal-name (downcase (caar signal-alist))
signal-entry (car signal-alist))
(cond ((member signal-name written-list)
nil)
((member signal-name multi-in-list)
(vhdl-goto-marker port-in-pos)
(setq port-end-pos
(vhdl-max-marker
port-end-pos (vhdl-compose-insert-port signal-entry)))
(setq port-in-pos (point-marker))
(vhdl--pushnew signal-name written-list :test #'equal))
((member signal-name multi-out-list)
(vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos))
(setq port-end-pos
(vhdl-max-marker
port-end-pos (vhdl-compose-insert-port signal-entry)))
(setq port-out-pos (point-marker))
(vhdl--pushnew signal-name written-list :test #'equal))
((or (member signal-name single-in-list)
(member signal-name single-out-list))
(vhdl-goto-marker
(vhdl-max-marker
port-inst-pos
(vhdl-max-marker port-out-pos port-in-pos)))
(setq port-end-pos (vhdl-compose-insert-port signal-entry))
(setq port-inst-pos (point-marker))
(vhdl--pushnew signal-name written-list :test #'equal))
((equal (upcase (nth 2 signal-entry)) "OUT")
(vhdl-goto-marker signal-pos)
(vhdl-compose-insert-signal signal-entry)
(setq signal-pos (point-marker))
(vhdl--pushnew signal-name written-list :test #'equal)))
(setq signal-alist (cdr signal-alist)))
(when (/= port-temp-pos port-inst-pos)
(vhdl-goto-marker
(vhdl-max-marker port-temp-pos
(vhdl-max-marker port-in-pos port-out-pos)))
(insert "\n") (indent-to (* 2 vhdl-basic-offset))
(insert "-- ports to \"" inst-name "\"\n")
(vhdl-goto-marker port-inst-pos))
(when (/= signal-temp-pos signal-pos)
(vhdl-goto-marker signal-temp-pos)
(insert "\n") (indent-to vhdl-basic-offset)
(insert "-- outputs of \"" inst-name "\"\n")
(vhdl-goto-marker signal-pos))
(setq inst-alist (cdr inst-alist)))
;; finalize generic/port clause
(vhdl-goto-marker generic-end-pos) (backward-char)
(when (= generic-beg-pos generic-end-pos)
(insert "\n") (indent-to (* 2 vhdl-basic-offset))
(insert ";") (backward-char))
(insert ")")
(vhdl-goto-marker port-end-pos) (backward-char)
(when (= port-beg-pos port-end-pos)
(insert "\n") (indent-to (* 2 vhdl-basic-offset))
(insert ";") (backward-char))
(insert ")")
;; align everything
(when vhdl-auto-align
(vhdl-goto-marker generic-beg-pos)
(vhdl-align-region-groups generic-beg-pos generic-end-pos 1)
(vhdl-align-region-groups port-beg-pos port-end-pos 1)
(vhdl-goto-marker signal-beg-pos)
(vhdl-align-region-groups signal-beg-pos signal-pos))
(switch-to-buffer (marker-buffer signal-beg-pos))
(message "Wiring components...done")))))