+ "Adjust case or following NUM words."
+ (if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)))
+
+(defun vhdl-minibuffer-tab (&optional prefix-arg)
+ "If preceeding character is part of a word or a paren then hippie-expand,
+else insert tab (used for word completion in VHDL minibuffer)."
+ (interactive "P")
+ (cond
+ ;; expand word
+ ((= (char-syntax (preceding-char)) ?w)
+ (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
+ (case-replace nil)
+ (hippie-expand-only-buffers
+ (or (and (boundp 'hippie-expand-only-buffers)
+ hippie-expand-only-buffers)
+ '(vhdl-mode))))
+ (vhdl-expand-abbrev prefix-arg)))
+ ;; expand parenthesis
+ ((or (= (preceding-char) ?\() (= (preceding-char) ?\)))
+ (let ((case-fold-search (not vhdl-word-completion-case-sensitive))
+ (case-replace nil))
+ (vhdl-expand-paren prefix-arg)))
+ ;; insert tab
+ (t (insert-tab))))
+
+(defun vhdl-template-search-prompt ()
+ "Search for left out template prompts and query again."
+ (interactive)
+ (vhdl-prepare-search-2
+ (when (or (re-search-forward
+ (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t)
+ (re-search-backward
+ (concat "<\\(" vhdl-template-prompt-syntax "\\)>") nil t))
+ (let ((string (match-string 1)))
+ (replace-match "")
+ (vhdl-template-field string)))))
+
+(defun vhdl-template-undo (begin end)
+ "Undo aborted template by deleting region and unexpanding the keyword."
+ (cond (vhdl-template-invoked-by-hook
+ (goto-char end)
+ (insert " ")
+ (delete-region begin end)
+ (unexpand-abbrev))
+ (t (delete-region begin end))))
+
+(defun vhdl-insert-string-or-file (string)
+ "Insert STRING or file contents if STRING is an existing file name."
+ (unless (equal string "")
+ (let ((file-name
+ (progn (string-match "^\\([^\n]+\\)" string)
+ (vhdl-resolve-env-variable (match-string 1 string)))))
+ (if (file-exists-p file-name)
+ (forward-char (cadr (insert-file-contents file-name)))
+ (insert string)))))
+
+(defun vhdl-beginning-of-block ()
+ "Move cursor to the beginning of the enclosing block."
+ (let (pos)
+ (save-excursion
+ (beginning-of-line)
+ ;; search backward for block beginning or end
+ (while (or (while (and (setq pos (re-search-backward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
+ ;; not consider subprogram declarations
+ (or (and (match-string 5)
+ (save-match-data
+ (save-excursion
+ (goto-char (match-end 5))
+ (forward-word 1) (forward-sexp)
+ (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
+ (match-string 1)))
+ ;; not consider configuration specifications
+ (and (match-string 6)
+ (save-match-data
+ (save-excursion
+ (vhdl-end-of-block)
+ (beginning-of-line)
+ (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
+ (match-string 2))
+ ;; skip subblock if block end found
+ (vhdl-beginning-of-block)))
+ (when pos (goto-char pos))))
+
+(defun vhdl-end-of-block ()
+ "Move cursor to the end of the enclosing block."
+ (let (pos)
+ (save-excursion
+ (end-of-line)
+ ;; search forward for block beginning or end
+ (while (or (while (and (setq pos (re-search-forward "^\\s-*\\(\\(end\\)\\|\\(\\(impure\\|pure\\)[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(for\\)\\|\\(architecture\\|component\\|configuration\\|entity\\|package\\|record\\|units\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(postponed[ \t\n]+\\)?\\(block\\|case\\|for\\|if\\|procedural\\|process\\|while\\)\\)\\>" nil t))
+ ;; not consider subprogram declarations
+ (or (and (match-string 5)
+ (save-match-data
+ (save-excursion (re-search-forward "\\<is\\>\\|\\(;\\)" nil t))
+ (match-string 1)))
+ ;; not consider configuration specifications
+ (and (match-string 6)
+ (save-match-data
+ (save-excursion
+ (vhdl-end-of-block)
+ (beginning-of-line)
+ (not (looking-at "^\\s-*end\\s-+\\(for\\|generate\\|loop\\)\\>"))))))))
+ (not (match-string 2)))
+ ;; skip subblock if block beginning found
+ (vhdl-end-of-block)))
+ (when pos (goto-char pos))))
+
+(defun vhdl-sequential-statement-p ()
+ "Check if point is within sequential statement part."
+ (let ((start (point)))
+ (save-excursion
+ (vhdl-prepare-search-2
+ ;; is sequential statement if ...
+ (and (re-search-backward "^\\s-*begin\\>" nil t)
+ ;; ... point is between "begin" and "end" of ...
+ (progn (vhdl-end-of-block)
+ (< start (point)))
+ ;; ... a sequential block
+ (progn (vhdl-beginning-of-block)
+ (looking-at "^\\s-*\\(\\(\\w+[ \t\n]+\\)?\\(function\\|procedure\\)\\|\\(\\w+[ \t\n]*:[ \t\n]*\\)?\\(\\w+[ \t\n]+\\)?\\(procedural\\|process\\)\\)\\>")))))))
+
+(defun vhdl-in-argument-list-p ()
+ "Check if within an argument list."
+ (save-excursion
+ (vhdl-prepare-search-2
+ (or (string-match "arglist"
+ (format "%s" (caar (vhdl-get-syntactic-context))))
+ (progn (beginning-of-line)
+ (looking-at "^\\s-*\\(generic\\|port\\|\\(\\(impure\\|pure\\)\\s-+\\|\\)function\\|procedure\\)\\>\\s-*\\(\\w+\\s-*\\)?("))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Abbrev hooks
+
+(defun vhdl-hooked-abbrev (func)
+ "Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,
+but not if inside a comment or quote)."
+ (if (or (vhdl-in-literal)
+ (save-excursion
+ (forward-word -1)
+ (and (looking-at "\\<end\\>") (not (looking-at "\\<end;")))))
+ (progn
+ (insert " ")
+ (unexpand-abbrev)
+ (delete-char -1))
+ (if (not vhdl-electric-mode)
+ (progn
+ (insert " ")
+ (unexpand-abbrev)
+ (backward-word 1)
+ (vhdl-case-word 1)
+ (delete-char 1))
+ (let ((invoke-char last-command-char)
+ (abbrev-mode -1)
+ (vhdl-template-invoked-by-hook t))
+ (let ((caught (catch 'abort
+ (funcall func))))
+ (when (stringp caught) (message caught)))
+ (when (= invoke-char ?-) (setq abbrev-start-location (point)))
+ ;; delete CR which is still in event queue
+ (if vhdl-xemacs
+ (enqueue-eval-event 'delete-char -1)
+ (setq unread-command-events ; push back a delete char
+ (list (vhdl-character-to-event ?\177))))))))
+
+(defun vhdl-template-alias-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-alias))
+(defun vhdl-template-architecture-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-architecture))
+(defun vhdl-template-assert-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-assert))
+(defun vhdl-template-attribute-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-attribute))
+(defun vhdl-template-block-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-block))
+(defun vhdl-template-break-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-break))
+(defun vhdl-template-case-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-case))
+(defun vhdl-template-component-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-component))
+(defun vhdl-template-instance-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-instance))
+(defun vhdl-template-conditional-signal-asst-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-conditional-signal-asst))
+(defun vhdl-template-configuration-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-configuration))
+(defun vhdl-template-constant-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-constant))
+(defun vhdl-template-disconnect-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-disconnect))
+(defun vhdl-template-display-comment-hook ()
+ (vhdl-hooked-abbrev 'vhdl-comment-display))
+(defun vhdl-template-else-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-else))
+(defun vhdl-template-elsif-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-elsif))
+(defun vhdl-template-entity-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-entity))
+(defun vhdl-template-exit-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-exit))
+(defun vhdl-template-file-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-file))
+(defun vhdl-template-for-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-for))
+(defun vhdl-template-function-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-function))
+(defun vhdl-template-generic-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-generic))
+(defun vhdl-template-group-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-group))
+(defun vhdl-template-library-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-library))
+(defun vhdl-template-limit-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-limit))
+(defun vhdl-template-if-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-if))
+(defun vhdl-template-bare-loop-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-bare-loop))
+(defun vhdl-template-map-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-map))
+(defun vhdl-template-nature-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-nature))
+(defun vhdl-template-next-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-next))
+(defun vhdl-template-others-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-others))
+(defun vhdl-template-package-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-package))
+(defun vhdl-template-port-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-port))
+(defun vhdl-template-procedural-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-procedural))
+(defun vhdl-template-procedure-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-procedure))
+(defun vhdl-template-process-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-process))
+(defun vhdl-template-quantity-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-quantity))
+(defun vhdl-template-report-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-report))
+(defun vhdl-template-return-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-return))
+(defun vhdl-template-selected-signal-asst-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-selected-signal-asst))
+(defun vhdl-template-signal-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-signal))
+(defun vhdl-template-subnature-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-subnature))
+(defun vhdl-template-subtype-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-subtype))
+(defun vhdl-template-terminal-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-terminal))
+(defun vhdl-template-type-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-type))
+(defun vhdl-template-use-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-use))
+(defun vhdl-template-variable-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-variable))
+(defun vhdl-template-wait-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-wait))
+(defun vhdl-template-when-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-when))
+(defun vhdl-template-while-loop-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-while-loop))
+(defun vhdl-template-with-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-with))
+(defun vhdl-template-and-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-and))
+(defun vhdl-template-or-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-or))
+(defun vhdl-template-nand-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-nand))
+(defun vhdl-template-nor-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-nor))
+(defun vhdl-template-xor-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-xor))
+(defun vhdl-template-xnor-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-xnor))
+(defun vhdl-template-not-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-not))
+
+(defun vhdl-template-default-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-default))
+(defun vhdl-template-default-indent-hook ()
+ (vhdl-hooked-abbrev 'vhdl-template-default-indent))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Template insertion from completion list
+
+(defun vhdl-template-insert-construct (name)
+ "Insert the built-in construct template with NAME."
+ (interactive
+ (list (let ((completion-ignore-case t))
+ (completing-read "Construct name: "
+ vhdl-template-construct-alist nil t))))
+ (vhdl-template-insert-fun
+ (cadr (assoc name vhdl-template-construct-alist))))
+
+(defun vhdl-template-insert-package (name)
+ "Insert the built-in package template with NAME."
+ (interactive
+ (list (let ((completion-ignore-case t))
+ (completing-read "Package name: "
+ vhdl-template-package-alist nil t))))
+ (vhdl-template-insert-fun
+ (cadr (assoc name vhdl-template-package-alist))))
+
+(defun vhdl-template-insert-directive (name)
+ "Insert the built-in directive template with NAME."
+ (interactive
+ (list (let ((completion-ignore-case t))
+ (completing-read "Directive name: "
+ vhdl-template-directive-alist nil t))))
+ (vhdl-template-insert-fun
+ (cadr (assoc name vhdl-template-directive-alist))))
+
+(defun vhdl-template-insert-fun (fun)
+ "Call FUN to insert a built-in template."
+ (let ((caught (catch 'abort (when fun (funcall fun)))))
+ (when (stringp caught) (message caught))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Models
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun vhdl-model-insert (model-name)
+ "Insert the user model with name MODEL-NAME."
+ (interactive
+ (let ((completion-ignore-case t))
+ (list (completing-read "Model name: " vhdl-model-alist))))
+ (indent-according-to-mode)
+ (let ((start (point-marker))
+ (margin (current-indentation))
+ model position prompt string end)
+ (vhdl-prepare-search-2
+ (when (setq model (assoc model-name vhdl-model-alist))
+ ;; insert model
+ (beginning-of-line)
+ (delete-horizontal-space)
+ (goto-char start)
+ (vhdl-insert-string-or-file (nth 1 model))
+ (setq end (point-marker))
+ ;; indent code
+ (goto-char start)
+ (beginning-of-line)
+ (while (< (point) end)
+ (unless (looking-at "^$")
+ (insert-char ? margin))
+ (beginning-of-line 2))
+ (goto-char start)
+ ;; insert clock
+ (unless (equal "" vhdl-clock-name)
+ (while (re-search-forward "<clock>" end t)
+ (replace-match vhdl-clock-name)))
+ (goto-char start)
+ ;; insert reset
+ (unless (equal "" vhdl-reset-name)
+ (while (re-search-forward "<reset>" end t)
+ (replace-match vhdl-reset-name)))
+ ;; replace header prompts
+ (vhdl-template-replace-header-keywords start end nil t)
+ (goto-char start)
+ ;; query other prompts
+ (while (re-search-forward
+ (concat "<\\(" vhdl-template-prompt-syntax "\\)>") end t)
+ (unless (equal "cursor" (match-string 1))
+ (setq position (match-beginning 1))
+ (setq prompt (match-string 1))
+ (replace-match "")
+ (setq string (vhdl-template-field prompt nil t))
+ ;; replace occurrences of same prompt
+ (while (re-search-forward (concat "<\\(" prompt "\\)>") end t)
+ (replace-match (or string "")))
+ (goto-char position)))
+ (goto-char start)
+ ;; goto final position
+ (if (re-search-forward "<cursor>" end t)
+ (replace-match "")
+ (goto-char end))))))
+
+(defun vhdl-model-defun ()
+ "Define help and hook functions for user models."
+ (let ((model-alist vhdl-model-alist)
+ model-name model-keyword)
+ (while model-alist
+ ;; define functions for user models that can be invoked from menu and key
+ ;; bindings and which themselves call `vhdl-model-insert' with the model
+ ;; name as argument
+ (setq model-name (nth 0 (car model-alist)))
+ (eval `(defun ,(vhdl-function-name "vhdl-model" model-name) ()
+ ,(concat "Insert model for \"" model-name "\".")
+ (interactive)
+ (vhdl-model-insert ,model-name)))
+ ;; define hooks for user models that are invoked from keyword abbrevs
+ (setq model-keyword (nth 3 (car model-alist)))
+ (unless (equal model-keyword "")
+ (eval `(defun
+ ,(vhdl-function-name
+ "vhdl-model" model-name "hook") ()
+ (vhdl-hooked-abbrev
+ ',(vhdl-function-name "vhdl-model" model-name)))))
+ (setq model-alist (cdr model-alist)))))
+
+(vhdl-model-defun)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Port translation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar vhdl-port-list nil
+ "Variable to hold last port map parsed.")
+;; structure: (parenthesised expression means list of such entries)
+;; (ent-name
+;; ((generic-names) generic-type generic-init generic-comment group-comment)
+;; ((port-names) port-object port-direct port-type port-comment group-comment)
+;; (lib-name pack-key))
+
+(defun vhdl-parse-string (string &optional optional)
+ "Check that the text following point matches the regexp in STRING."
+ (if (looking-at string)
+ (goto-char (match-end 0))
+ (unless optional
+ (throw 'parse (format "ERROR: Syntax error near line %s, expecting \"%s\""
+ (vhdl-current-line) string)))
+ nil))
+
+(defun vhdl-replace-string (regexp-cons string)
+ "Replace STRING from car of REGEXP-CONS to cdr of REGEXP-CONS."
+ (vhdl-prepare-search-1
+ (if (string-match (car regexp-cons) string)
+ (funcall vhdl-file-name-case
+ (replace-match (cdr regexp-cons) t nil string))
+ string)))
+
+(defun vhdl-parse-group-comment ()
+ "Parse comment and empty lines between groups of lines."
+ (let ((start (point))
+ string)
+ (vhdl-forward-comment (point-max))
+ (setq string (buffer-substring-no-properties start (point)))
+ ;; strip off leading blanks and first newline
+ (while (string-match "^\\(\\s-+\\)" string)
+ (setq string (concat (substring string 0 (match-beginning 1))
+ (substring string (match-end 1)))))
+ (if (and (not (equal string "")) (equal (substring string 0 1) "\n"))
+ (substring string 1)
+ string)))
+
+(defun vhdl-paste-group-comment (string indent)
+ "Paste comment and empty lines from STRING between groups of lines
+with INDENT."
+ (let ((pos (point-marker)))
+ (when (> indent 0)
+ (while (string-match "^\\(--\\)" string)
+ (setq string (concat (substring string 0 (match-beginning 1))
+ (make-string indent ? )
+ (substring string (match-beginning 1))))))
+ (beginning-of-line)
+ (insert string)
+ (goto-char pos)))
+
+(defvar vhdl-port-flattened nil
+ "Indicates whether a port has been flattened.")
+
+(defun vhdl-port-flatten (&optional as-alist)
+ "Flatten port list so that only one generic/port exists per line."
+ (interactive)
+ (if (not vhdl-port-list)
+ (error "ERROR: No port has been read")
+ (message "Flattening port...")
+ (let ((new-vhdl-port-list (list (car vhdl-port-list)))
+ (old-vhdl-port-list (cdr vhdl-port-list))
+ old-port-list new-port-list old-port new-port names)
+ ;; traverse port list and flatten entries
+ (while (cdr old-vhdl-port-list)
+ (setq old-port-list (car old-vhdl-port-list))
+ (setq new-port-list nil)
+ (while old-port-list
+ (setq old-port (car old-port-list))
+ (setq names (car old-port))
+ (while names
+ (setq new-port (cons (if as-alist (car names) (list (car names)))
+ (cdr old-port)))
+ (setq new-port-list (append new-port-list (list new-port)))
+ (setq names (cdr names)))
+ (setq old-port-list (cdr old-port-list)))
+ (setq old-vhdl-port-list (cdr old-vhdl-port-list))
+ (setq new-vhdl-port-list (append new-vhdl-port-list
+ (list new-port-list))))
+ (setq vhdl-port-list
+ (append new-vhdl-port-list (list old-vhdl-port-list))
+ vhdl-port-flattened t)
+ (message "Flattening port...done"))))
+
+(defvar vhdl-port-reversed-direction nil
+ "Indicates whether port directions are reversed.")
+
+(defun vhdl-port-reverse-direction ()
+ "Reverse direction for all ports (useful in testbenches)."
+ (interactive)
+ (if (not vhdl-port-list)
+ (error "ERROR: No port has been read")
+ (message "Reversing port directions...")
+ (let ((port-list (nth 2 vhdl-port-list))
+ port-dir-car port-dir)
+ ;; traverse port list and reverse directions
+ (while port-list
+ (setq port-dir-car (cddr (car port-list))
+ port-dir (car port-dir-car))
+ (setcar port-dir-car
+ (cond ((equal port-dir "in") "out")
+ ((equal port-dir "out") "in")
+ (t port-dir)))
+ (setq port-list (cdr port-list)))
+ (setq vhdl-port-reversed-direction (not vhdl-port-reversed-direction))
+ (message "Reversing port directions...done"))))
+
+(defun vhdl-port-copy ()
+ "Get generic and port information from an entity or component declaration."
+ (interactive)
+ (save-excursion
+ (let (parse-error end-of-list
+ decl-type name generic-list port-list context-clause
+ object names direct type init comment group-comment)
+ (vhdl-prepare-search-2
+ (setq
+ parse-error
+ (catch 'parse
+ ;; check if within entity or component declaration
+ (end-of-line)
+ (when (or (not (re-search-backward
+ "^\\s-*\\(component\\|entity\\|end\\)\\>" nil t))
+ (equal "END" (upcase (match-string 1))))
+ (throw 'parse "ERROR: Not within an entity or component declaration"))
+ (setq decl-type (downcase (match-string-no-properties 1)))
+ (forward-word 1)
+ (vhdl-parse-string "\\s-+\\(\\w+\\)\\(\\s-+is\\>\\)?")
+ (setq name (match-string-no-properties 1))
+ (message "Reading port of %s \"%s\"..." decl-type name)
+ (vhdl-forward-syntactic-ws)
+ ;; parse generic clause
+ (when (vhdl-parse-string "generic[ \t\n]*(" t)
+ ;; parse group comment and spacing
+ (setq group-comment (vhdl-parse-group-comment))
+ (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
+ (while (not end-of-list)
+ ;; parse names
+ (vhdl-parse-string "\\(\\w+\\)[ \t\n]*")
+ (setq names (list (match-string-no-properties 1)))
+ (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\)[ \t\n]*" t)
+ (setq names
+ (append names (list (match-string-no-properties 1)))))
+ ;; parse type
+ (vhdl-parse-string ":[ \t\n]*\\([^():;\n]+\\)")
+ (setq type (match-string-no-properties 1))
+ (setq comment nil)
+ (while (looking-at "(")
+ (setq type
+ (concat type
+ (buffer-substring-no-properties
+ (point) (progn (forward-sexp) (point)))
+ (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
+ (match-string-no-properties 1)))))
+ ;; special case: closing parenthesis is on separate line
+ (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
+ (setq comment (substring type (match-beginning 2)))
+ (setq type (substring type 0 (match-beginning 1))))
+ ;; strip of trailing group-comment
+ (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
+ (setq type (substring type 0 (match-end 1)))
+ ;; parse initialization expression
+ (setq init nil)
+ (when (vhdl-parse-string ":=[ \t\n]*" t)
+ (vhdl-parse-string "\\([^();\n]*\\)")
+ (setq init (match-string-no-properties 1))
+ (while (looking-at "(")
+ (setq init
+ (concat init
+ (buffer-substring-no-properties
+ (point) (progn (forward-sexp) (point)))
+ (and (vhdl-parse-string "\\([^();\n]*\\)" t)
+ (match-string-no-properties 1))))))
+ ;; special case: closing parenthesis is on separate line
+ (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
+ (setq comment (substring init (match-beginning 2)))
+ (setq init (substring init 0 (match-beginning 1)))
+ (vhdl-forward-syntactic-ws))
+ (skip-chars-forward " \t")
+ ;; parse inline comment, special case: as above, no initial.
+ (unless comment
+ (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
+ (match-string-no-properties 1))))
+ (vhdl-forward-syntactic-ws)
+ (setq end-of-list (vhdl-parse-string ")" t))
+ (vhdl-parse-string "\\s-*;\\s-*")
+ ;; parse inline comment
+ (unless comment
+ (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
+ (match-string-no-properties 1))))
+ ;; save everything in list
+ (setq generic-list (append generic-list
+ (list (list names type init
+ comment group-comment))))
+ ;; parse group comment and spacing
+ (setq group-comment (vhdl-parse-group-comment))))
+ ;; parse port clause
+ (when (vhdl-parse-string "port[ \t\n]*(" t)
+ ;; parse group comment and spacing
+ (setq group-comment (vhdl-parse-group-comment))
+ (setq end-of-list (vhdl-parse-string ")[ \t\n]*;[ \t\n]*" t))
+ (while (not end-of-list)
+ ;; parse object
+ (setq object
+ (and (vhdl-parse-string "\\(signal\\|quantity\\|terminal\\)[ \t\n]*" t)
+ (match-string-no-properties 1)))
+ ;; parse names (accept extended identifiers)
+ (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
+ (setq names (list (match-string-no-properties 1)))
+ (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
+ (setq names (append names (list (match-string-no-properties 1)))))
+ ;; parse direction
+ (vhdl-parse-string ":[ \t\n]*")
+ (setq direct
+ (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n]+" t)
+ (match-string-no-properties 1)))
+ ;; parse type
+ (vhdl-parse-string "\\([^();\n]+\\)")
+ (setq type (match-string-no-properties 1))
+ (setq comment nil)
+ (while (looking-at "(")
+ (setq type (concat type
+ (buffer-substring-no-properties
+ (point) (progn (forward-sexp) (point)))
+ (and (vhdl-parse-string "\\([^();\n]*\\)" t)
+ (match-string-no-properties 1)))))
+ ;; special case: closing parenthesis is on separate line
+ (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
+ (setq comment (substring type (match-beginning 2)))
+ (setq type (substring type 0 (match-beginning 1))))
+ ;; strip of trailing group-comment
+ (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
+ (setq type (substring type 0 (match-end 1)))
+ (vhdl-forward-syntactic-ws)
+ (setq end-of-list (vhdl-parse-string ")" t))
+ (vhdl-parse-string "\\s-*;\\s-*")
+ ;; parse inline comment
+ (unless comment
+ (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
+ (match-string-no-properties 1))))
+ ;; save everything in list
+ (setq port-list (append port-list
+ (list (list names object direct type
+ comment group-comment))))
+ ;; parse group comment and spacing
+ (setq group-comment (vhdl-parse-group-comment))))
+; (vhdl-parse-string "end\\>")
+ ;; parse context clause
+ (setq context-clause (vhdl-scan-context-clause))
+; ;; add surrounding package to context clause
+; (when (and (equal decl-type "component")
+; (re-search-backward "^\\s-*package\\s-+\\(\\w+\\)" nil t))
+; (setq context-clause
+; (append context-clause
+; (list (cons (vhdl-work-library)
+; (match-string-no-properties 1))))))
+ (message "Reading port of %s \"%s\"...done" decl-type name)
+ nil)))
+ ;; finish parsing
+ (if parse-error
+ (error parse-error)
+ (setq vhdl-port-list (list name generic-list port-list context-clause)
+ vhdl-port-reversed-direction nil
+ vhdl-port-flattened nil)))))
+
+(defun vhdl-port-paste-context-clause (&optional exclude-pack-name)
+ "Paste a context clause."
+ (let ((margin (current-indentation))
+ (clause-list (nth 3 vhdl-port-list))
+ clause)
+ (while clause-list
+ (setq clause (car clause-list))
+ (unless (or (and exclude-pack-name (equal (downcase (cdr clause))
+ (downcase exclude-pack-name)))
+ (save-excursion
+ (re-search-backward
+ (concat "^\\s-*use\\s-+" (car clause)
+ "\." (cdr clause) "\\>") nil t)))
+ (vhdl-template-standard-package (car clause) (cdr clause))
+ (insert "\n"))
+ (setq clause-list (cdr clause-list)))))
+
+(defun vhdl-port-paste-generic (&optional no-init)
+ "Paste a generic clause."
+ (let ((margin (current-indentation))
+ (generic-list (nth 1 vhdl-port-list))
+ list-margin start names generic)
+ ;; paste generic clause
+ (when generic-list
+ (setq start (point))
+ (vhdl-insert-keyword "GENERIC (")
+ (unless vhdl-argument-list-indent
+ (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
+ (setq list-margin (current-column))
+ (while generic-list
+ (setq generic (car generic-list))
+ ;; paste group comment and spacing
+ (when (memq vhdl-include-group-comments '(decl always))
+ (vhdl-paste-group-comment (nth 4 generic) list-margin))
+ ;; paste names
+ (setq names (nth 0 generic))
+ (while names
+ (insert (car names))
+ (setq names (cdr names))
+ (when names (insert ", ")))
+ ;; paste type
+ (insert " : " (nth 1 generic))
+ ;; paste initialization
+ (when (and (not no-init) (nth 2 generic))
+ (insert " := " (nth 2 generic)))
+ (unless (cdr generic-list) (insert ")"))
+ (insert ";")
+ ;; paste comment
+ (when (and vhdl-include-port-comments (nth 3 generic))
+ (vhdl-comment-insert-inline (nth 3 generic) t))
+ (setq generic-list (cdr generic-list))
+ (when generic-list (insert "\n") (indent-to list-margin)))
+ ;; align generic clause
+ (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))))
+
+(defun vhdl-port-paste-port ()
+ "Paste a port clause."
+ (let ((margin (current-indentation))
+ (port-list (nth 2 vhdl-port-list))
+ list-margin start names port)
+ ;; paste port clause
+ (when port-list
+ (setq start (point))
+ (vhdl-insert-keyword "PORT (")
+ (unless vhdl-argument-list-indent
+ (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
+ (setq list-margin (current-column))
+ (while port-list
+ (setq port (car port-list))
+ ;; paste group comment and spacing
+ (when (memq vhdl-include-group-comments '(decl always))
+ (vhdl-paste-group-comment (nth 5 port) list-margin))
+ ;; paste object
+ (when (nth 1 port) (insert (nth 1 port) " "))
+ ;; paste names
+ (setq names (nth 0 port))
+ (while names
+ (insert (car names))
+ (setq names (cdr names))
+ (when names (insert ", ")))
+ ;; paste direction
+ (insert " : ")
+ (when (nth 2 port) (insert (nth 2 port) " "))
+ ;; paste type
+ (insert (nth 3 port))
+ (unless (cdr port-list) (insert ")"))
+ (insert ";")
+ ;; paste comment
+ (when (and vhdl-include-port-comments (nth 4 port))
+ (vhdl-comment-insert-inline (nth 4 port) t))
+ (setq port-list (cdr port-list))
+ (when port-list (insert "\n") (indent-to list-margin)))
+ ;; align port clause
+ (when vhdl-auto-align (vhdl-align-region-groups start (point) 1)))))
+
+(defun vhdl-port-paste-declaration (kind &optional no-indent)
+ "Paste as an entity or component declaration."
+ (unless no-indent (indent-according-to-mode))
+ (let ((margin (current-indentation))
+ (name (nth 0 vhdl-port-list)))
+ (vhdl-insert-keyword (if (eq kind 'entity) "ENTITY " "COMPONENT "))
+ (insert name)
+ (when (or (eq kind 'entity) (not (vhdl-standard-p '87)))
+ (vhdl-insert-keyword " IS"))
+ ;; paste generic and port clause
+ (when (nth 1 vhdl-port-list)
+ (insert "\n")
+ (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
+ (insert "\n"))
+ (indent-to (+ margin vhdl-basic-offset))
+ (vhdl-port-paste-generic (eq kind 'component)))
+ (when (nth 2 vhdl-port-list)
+ (insert "\n")
+ (when (and (memq vhdl-insert-empty-lines '(unit all))
+ (eq kind 'entity))
+ (insert "\n"))
+ (indent-to (+ margin vhdl-basic-offset)))
+ (vhdl-port-paste-port)
+ (insert "\n")
+ (when (and (memq vhdl-insert-empty-lines '(unit all)) (eq kind 'entity))
+ (insert "\n"))
+ (indent-to margin)
+ (vhdl-insert-keyword "END")
+ (if (eq kind 'entity)
+ (progn
+ (unless (vhdl-standard-p '87) (vhdl-insert-keyword " ENTITY"))
+ (insert " " name))
+ (vhdl-insert-keyword " COMPONENT")
+ (unless (vhdl-standard-p '87) (insert " " name)))
+ (insert ";")))
+
+(defun vhdl-port-paste-entity (&optional no-indent)
+ "Paste as an entity declaration."
+ (interactive)
+ (if (not vhdl-port-list)
+ (error "ERROR: No port read")
+ (message "Pasting port as entity \"%s\"..." (car vhdl-port-list))
+ (vhdl-port-paste-declaration 'entity no-indent)
+ (message "Pasting port as entity \"%s\"...done" (car vhdl-port-list))))
+
+(defun vhdl-port-paste-component (&optional no-indent)
+ "Paste as a component declaration."
+ (interactive)
+ (if (not vhdl-port-list)
+ (error "ERROR: No port read")
+ (message "Pasting port as component \"%s\"..." (car vhdl-port-list))
+ (vhdl-port-paste-declaration 'component no-indent)
+ (message "Pasting port as component \"%s\"...done" (car vhdl-port-list))))
+
+(defun vhdl-port-paste-generic-map (&optional secondary no-constants)
+ "Paste as a generic map."
+ (interactive)
+ (unless secondary (indent-according-to-mode))
+ (let ((margin (current-indentation))
+ list-margin start generic
+ (generic-list (nth 1 vhdl-port-list)))
+ (when generic-list
+ (setq start (point))
+ (vhdl-insert-keyword "GENERIC MAP (")
+ (if (not vhdl-association-list-with-formals)
+ ;; paste list of actual generics
+ (while generic-list
+ (insert (if no-constants
+ (car (nth 0 (car generic-list)))
+ (or (nth 2 (car generic-list)) " ")))
+ (setq generic-list (cdr generic-list))
+ (insert (if generic-list ", " ")")))
+ (unless vhdl-argument-list-indent
+ (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
+ (setq list-margin (current-column))
+ (while generic-list
+ (setq generic (car generic-list))
+ ;; paste group comment and spacing
+ (when (eq vhdl-include-group-comments 'always)
+ (vhdl-paste-group-comment (nth 4 generic) list-margin))
+ ;; paste formal and actual generic
+ (insert (car (nth 0 generic)) " => "
+ (if no-constants
+ (car (nth 0 generic))
+ (or (nth 2 generic) "")))
+ (setq generic-list (cdr generic-list))
+ (insert (if generic-list "," ")"))
+ ;; paste comment
+ (when (or vhdl-include-type-comments
+ (and vhdl-include-port-comments (nth 3 generic)))
+ (vhdl-comment-insert-inline
+ (concat
+ (when vhdl-include-type-comments
+ (concat "[" (nth 1 generic) "] "))
+ (when vhdl-include-port-comments (nth 3 generic))) t))
+ (when generic-list (insert "\n") (indent-to list-margin)))
+ ;; align generic map
+ (when vhdl-auto-align
+ (vhdl-align-region-groups start (point) 1 t))))))
+
+(defun vhdl-port-paste-port-map ()
+ "Paste as a port map."
+ (let ((margin (current-indentation))
+ list-margin start port
+ (port-list (nth 2 vhdl-port-list)))
+ (when port-list
+ (setq start (point))
+ (vhdl-insert-keyword "PORT MAP (")
+ (if (not vhdl-association-list-with-formals)
+ ;; paste list of actual ports
+ (while port-list
+ (insert (vhdl-replace-string vhdl-actual-port-name
+ (car (nth 0 (car port-list)))))
+ (setq port-list (cdr port-list))
+ (insert (if port-list ", " ");")))
+ (unless vhdl-argument-list-indent
+ (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
+ (setq list-margin (current-column))
+ (while port-list
+ (setq port (car port-list))
+ ;; paste group comment and spacing
+ (when (eq vhdl-include-group-comments 'always)
+ (vhdl-paste-group-comment (nth 5 port) list-margin))
+ ;; paste formal and actual port
+ (insert (car (nth 0 port)) " => ")
+ (insert (vhdl-replace-string vhdl-actual-port-name
+ (car (nth 0 port))))
+ (setq port-list (cdr port-list))
+ (insert (if port-list "," ");"))
+ ;; paste comment
+ (when (or vhdl-include-direction-comments
+ vhdl-include-type-comments
+ (and vhdl-include-port-comments (nth 4 port)))
+ (vhdl-comment-insert-inline
+ (concat
+ (cond ((and vhdl-include-direction-comments
+ vhdl-include-type-comments)
+ (concat "[" (format "%-4s" (concat (nth 2 port) " "))
+ (nth 3 port) "] "))
+ ((and vhdl-include-direction-comments (nth 2 port))
+ (format "%-6s" (concat "[" (nth 2 port) "] ")))
+ (vhdl-include-direction-comments " ")
+ (vhdl-include-type-comments
+ (concat "[" (nth 3 port) "] ")))
+ (when vhdl-include-port-comments (nth 4 port))) t))
+ (when port-list (insert "\n") (indent-to list-margin)))
+ ;; align port clause
+ (when vhdl-auto-align
+ (vhdl-align-region-groups start (point) 1))))))
+
+(defun vhdl-port-paste-instance (&optional name no-indent title)
+ "Paste as an instantiation."
+ (interactive)
+ (if (not vhdl-port-list)
+ (error "ERROR: No port read")
+ (let ((orig-vhdl-port-list vhdl-port-list))
+ ;; flatten local copy of port list (must be flat for port mapping)
+ (vhdl-port-flatten)
+ (unless no-indent (indent-according-to-mode))
+ (let ((margin (current-indentation)))
+ ;; paste instantiation
+ (cond (name
+ (insert name))
+ ((equal (cdr vhdl-instance-name) "")
+ (setq name (vhdl-template-field "instance name")))
+ ((string-match "\%d" (cdr vhdl-instance-name))
+ (let ((n 1))
+ (while (save-excursion
+ (setq name (format (vhdl-replace-string
+ vhdl-instance-name
+ (nth 0 vhdl-port-list)) n))
+ (goto-char (point-min))
+ (vhdl-re-search-forward name nil t))
+ (setq n (1+ n)))
+ (insert name)))
+ (t (insert (vhdl-replace-string vhdl-instance-name
+ (nth 0 vhdl-port-list)))))
+ (message "Pasting port as instantiation \"%s\"..." name)
+ (insert ": ")
+ (when title
+ (save-excursion
+ (beginning-of-line)
+ (indent-to vhdl-basic-offset)
+ (insert "-- instance \"" name "\"\n")))
+ (if (not (vhdl-use-direct-instantiation))
+ (insert (nth 0 vhdl-port-list))
+ (vhdl-insert-keyword "ENTITY ")
+ (insert (vhdl-work-library) "." (nth 0 vhdl-port-list)))
+ (when (nth 1 vhdl-port-list)
+ (insert "\n") (indent-to (+ margin vhdl-basic-offset))
+ (vhdl-port-paste-generic-map t t))
+ (when (nth 2 vhdl-port-list)
+ (insert "\n") (indent-to (+ margin vhdl-basic-offset))
+ (vhdl-port-paste-port-map))
+ (message "Pasting port as instantiation \"%s\"...done" name))
+ (setq vhdl-port-list orig-vhdl-port-list))))
+
+(defun vhdl-port-paste-constants (&optional no-indent)
+ "Paste generics as constants."
+ (interactive)
+ (if (not vhdl-port-list)
+ (error "ERROR: No port read")
+ (let ((orig-vhdl-port-list vhdl-port-list))
+ (message "Pasting port as constants...")
+ ;; flatten local copy of port list (must be flat for constant initial.)
+ (vhdl-port-flatten)
+ (unless no-indent (indent-according-to-mode))
+ (let ((margin (current-indentation))
+ start generic name
+ (generic-list (nth 1 vhdl-port-list)))
+ (when generic-list
+ (setq start (point))
+ (while generic-list
+ (setq generic (car generic-list))
+ ;; paste group comment and spacing
+ (when (memq vhdl-include-group-comments '(decl always))
+ (vhdl-paste-group-comment (nth 4 generic) margin))
+ (vhdl-insert-keyword "CONSTANT ")
+ ;; paste generic constants
+ (setq name (nth 0 generic))
+ (when name
+ (insert (car name))
+ ;; paste type
+ (insert " : " (nth 1 generic))
+ ;; paste initialization
+ (when (nth 2 generic)
+ (insert " := " (nth 2 generic)))
+ (insert ";")
+ ;; paste comment
+ (when (and vhdl-include-port-comments (nth 3 generic))
+ (vhdl-comment-insert-inline (nth 3 generic) t))
+ (setq generic-list (cdr generic-list))
+ (when generic-list (insert "\n") (indent-to margin))))
+ ;; align signal list
+ (when vhdl-auto-align
+ (vhdl-align-region-groups start (point) 1))))
+ (message "Pasting port as constants...done")
+ (setq vhdl-port-list orig-vhdl-port-list))))
+
+(defun vhdl-port-paste-signals (&optional initialize no-indent)
+ "Paste ports as internal signals."
+ (interactive)
+ (if (not vhdl-port-list)
+ (error "ERROR: No port read")
+ (message "Pasting port as signals...")
+ (unless no-indent (indent-according-to-mode))
+ (let ((margin (current-indentation))
+ start port names
+ (port-list (nth 2 vhdl-port-list)))
+ (when port-list
+ (setq start (point))
+ (while port-list
+ (setq port (car port-list))
+ ;; paste group comment and spacing
+ (when (memq vhdl-include-group-comments '(decl always))
+ (vhdl-paste-group-comment (nth 5 port) margin))
+ ;; paste object
+ (if (nth 1 port)
+ (insert (nth 1 port) " ")
+ (vhdl-insert-keyword "SIGNAL "))
+ ;; paste actual port signals
+ (setq names (nth 0 port))
+ (while names
+ (insert (vhdl-replace-string vhdl-actual-port-name (car names)))
+ (setq names (cdr names))
+ (when names (insert ", ")))
+ ;; paste type
+ (insert " : " (nth 3 port))
+ ;; paste initialization (inputs only)
+ (when (and initialize (equal "IN" (upcase (nth 2 port))))
+ (insert " := " (if (string-match "(.+)" (nth 3 port))
+ "(others => '0')" "'0'")))
+ (insert ";")
+ ;; paste comment
+ (when (or vhdl-include-direction-comments
+ (and vhdl-include-port-comments (nth 4 port)))
+ (vhdl-comment-insert-inline
+ (concat
+ (cond ((and vhdl-include-direction-comments (nth 2 port))
+ (format "%-6s" (concat "[" (nth 2 port) "] ")))
+ (vhdl-include-direction-comments " "))
+ (when vhdl-include-port-comments (nth 4 port))) t))
+ (setq port-list (cdr port-list))
+ (when port-list (insert "\n") (indent-to margin)))
+ ;; align signal list
+ (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
+ (message "Pasting port as signals...done")))
+
+(defun vhdl-port-paste-initializations (&optional no-indent)
+ "Paste ports as signal initializations."
+ (interactive)
+ (if (not vhdl-port-list)
+ (error "ERROR: No port read")
+ (let ((orig-vhdl-port-list vhdl-port-list))
+ (message "Pasting port as initializations...")
+ ;; flatten local copy of port list (must be flat for signal initial.)
+ (vhdl-port-flatten)
+ (unless no-indent (indent-according-to-mode))
+ (let ((margin (current-indentation))
+ start port name
+ (port-list (nth 2 vhdl-port-list)))
+ (when port-list
+ (setq start (point))
+ (while port-list
+ (setq port (car port-list))
+ ;; paste actual port signal (inputs only)
+ (when (equal "IN" (upcase (nth 2 port)))
+ (setq name (car (nth 0 port)))
+ (insert (vhdl-replace-string vhdl-actual-port-name name))
+ ;; paste initialization
+ (insert " <= " (if (string-match "(.+)" (nth 3 port))
+ "(others => '0')" "'0'") ";"))
+ (setq port-list (cdr port-list))
+ (when (and port-list
+ (equal "IN" (upcase (nth 2 (car port-list)))))
+ (insert "\n") (indent-to margin)))
+ ;; align signal list
+ (when vhdl-auto-align (vhdl-align-region-groups start (point) 1))))
+ (message "Pasting port as initializations...done")
+ (setq vhdl-port-list orig-vhdl-port-list))))
+
+(defun vhdl-port-paste-testbench ()
+ "Paste as a bare-bones testbench."
+ (interactive)
+ (if (not vhdl-port-list)
+ (error "ERROR: No port read")
+ (let ((case-fold-search t)
+ (ent-name (vhdl-replace-string vhdl-testbench-entity-name
+ (nth 0 vhdl-port-list)))
+ (source-buffer (current-buffer))
+ arch-name config-name ent-file-name arch-file-name
+ ent-buffer arch-buffer position)
+ ;; open entity file
+ (unless (eq vhdl-testbench-create-files 'none)
+ (setq ent-file-name
+ (concat ent-name "." (file-name-extension (buffer-file-name))))
+ (if (file-exists-p ent-file-name)
+ (if (y-or-n-p
+ (concat "File \"" ent-file-name "\" exists; overwrite? "))
+ (progn (find-file ent-file-name)
+ (erase-buffer)
+ (set-buffer-modified-p nil))
+ (if (eq vhdl-testbench-create-files 'separate)
+ (setq ent-file-name nil)
+ (error "ERROR: Pasting port as testbench...aborted")))
+ (find-file ent-file-name)))
+ (unless (and (eq vhdl-testbench-create-files 'separate)
+ (null ent-file-name))
+ ;; paste entity header
+ (if vhdl-testbench-include-header
+ (progn (vhdl-template-header
+ (concat "Testbench for design \""
+ (nth 0 vhdl-port-list) "\""))
+ (goto-char (point-max)))
+ (vhdl-comment-display-line) (insert "\n\n"))
+ ;; paste std_logic_1164 package
+ (when vhdl-testbench-include-library
+ (vhdl-template-package-std-logic-1164)
+ (insert "\n\n") (vhdl-comment-display-line) (insert "\n\n"))
+ ;; paste entity declaration
+ (vhdl-insert-keyword "ENTITY ")
+ (insert ent-name)
+ (vhdl-insert-keyword " IS")
+ (when (memq vhdl-insert-empty-lines '(unit all)) (insert "\n"))
+ (insert "\n")
+ (vhdl-insert-keyword "END ")
+ (unless (vhdl-standard-p '87) (vhdl-insert-keyword "ENTITY "))
+ (insert ent-name ";")
+ (insert "\n\n")
+ (vhdl-comment-display-line) (insert "\n"))
+ ;; get architecture name
+ (setq arch-name (if (equal (cdr vhdl-testbench-architecture-name) "")
+ (read-from-minibuffer "architecture name: "
+ nil vhdl-minibuffer-local-map)
+ (vhdl-replace-string vhdl-testbench-architecture-name
+ (nth 0 vhdl-port-list))))
+ (message "Pasting port as testbench \"%s(%s)\"..." ent-name arch-name)
+ ;; open architecture file
+ (if (not (eq vhdl-testbench-create-files 'separate))
+ (insert "\n")
+ (setq ent-buffer (current-buffer))
+ (setq arch-file-name
+ (concat ent-name "_" arch-name "."
+ (file-name-extension (buffer-file-name))))
+ (when (and (file-exists-p arch-file-name)
+ (not (y-or-n-p (concat "File \"" arch-file-name
+ "\" exists; overwrite? "))))
+ (error "ERROR: Pasting port as testbench...aborted"))
+ (find-file arch-file-name)
+ (erase-buffer)
+ (set-buffer-modified-p nil)
+ ;; paste architecture header
+ (if vhdl-testbench-include-header
+ (progn (vhdl-template-header
+ (concat "Testbench architecture for design \""
+ (nth 0 vhdl-port-list) "\""))
+ (goto-char (point-max)))
+ (vhdl-comment-display-line) (insert "\n\n")))
+ ;; paste architecture body
+ (vhdl-insert-keyword "ARCHITECTURE ")
+ (insert arch-name)
+ (vhdl-insert-keyword " OF ")
+ (insert ent-name)
+ (vhdl-insert-keyword " IS")
+ (insert "\n\n") (indent-to vhdl-basic-offset)
+ ;; paste component declaration
+ (unless (vhdl-use-direct-instantiation)
+ (vhdl-port-paste-component t)
+ (insert "\n\n") (indent-to vhdl-basic-offset))
+ ;; paste constants
+ (when (nth 1 vhdl-port-list)
+ (insert "-- component generics\n") (indent-to vhdl-basic-offset)
+ (vhdl-port-paste-constants t)
+ (insert "\n\n") (indent-to vhdl-basic-offset))
+ ;; paste internal signals
+ (insert "-- component ports\n") (indent-to vhdl-basic-offset)
+ (vhdl-port-paste-signals vhdl-testbench-initialize-signals t)
+ (insert "\n")
+ ;; paste custom declarations
+ (unless (equal "" vhdl-testbench-declarations)
+ (insert "\n")
+ (vhdl-insert-string-or-file vhdl-testbench-declarations))
+ (setq position (point))
+ (insert "\n\n")
+ (vhdl-comment-display-line) (insert "\n")
+ (when vhdl-testbench-include-configuration
+ (setq config-name (vhdl-replace-string
+ vhdl-testbench-configuration-name
+ (concat ent-name " " arch-name)))
+ (insert "\n")
+ (vhdl-insert-keyword "CONFIGURATION ") (insert config-name)
+ (vhdl-insert-keyword " OF ") (insert ent-name)
+ (vhdl-insert-keyword " IS\n")
+ (indent-to vhdl-basic-offset)
+ (vhdl-insert-keyword "FOR ") (insert arch-name "\n")
+ (indent-to vhdl-basic-offset)
+ (vhdl-insert-keyword "END FOR;\n")
+ (vhdl-insert-keyword "END ") (insert config-name ";\n\n")
+ (vhdl-comment-display-line) (insert "\n"))
+ (goto-char position)
+ (vhdl-template-begin-end
+ (unless (vhdl-standard-p '87) "ARCHITECTURE") arch-name 0 t)
+ ;; paste instantiation
+ (insert "-- component instantiation\n") (indent-to vhdl-basic-offset)
+ (vhdl-port-paste-instance
+ (vhdl-replace-string vhdl-testbench-dut-name (nth 0 vhdl-port-list)) t)
+ (insert "\n")
+ ;; paste custom statements
+ (unless (equal "" vhdl-testbench-statements)
+ (insert "\n")
+ (vhdl-insert-string-or-file vhdl-testbench-statements))
+ (insert "\n")
+ (indent-to vhdl-basic-offset)
+ (unless (eq vhdl-testbench-create-files 'none)
+ (setq arch-buffer (current-buffer))
+ (when ent-buffer (set-buffer ent-buffer) (save-buffer))
+ (set-buffer arch-buffer) (save-buffer))
+ (message
+ (concat (format "Pasting port as testbench \"%s(%s)\"...done"
+ ent-name arch-name)
+ (and ent-file-name
+ (format "\n File created: \"%s\"" ent-file-name))
+ (and arch-file-name
+ (format "\n File created: \"%s\"" arch-file-name)))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Subprogram interface translation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defvar vhdl-subprog-list nil
+ "Variable to hold last subprogram interface parsed.")
+;; structure: (parenthesised expression means list of such entries)
+;; (subprog-name kind
+;; ((names) object direct type init comment group-comment)
+;; return-type return-comment group-comment)
+
+(defvar vhdl-subprog-flattened nil
+ "Indicates whether an subprogram interface has been flattened.")
+
+(defun vhdl-subprog-flatten ()
+ "Flatten interface list so that only one parameter exists per line."
+ (interactive)
+ (if (not vhdl-subprog-list)
+ (error "ERROR: No subprogram interface has been read")
+ (message "Flattening subprogram interface...")
+ (let ((old-subprog-list (nth 2 vhdl-subprog-list))
+ new-subprog-list old-subprog new-subprog names)
+ ;; traverse parameter list and flatten entries
+ (while old-subprog-list
+ (setq old-subprog (car old-subprog-list))
+ (setq names (car old-subprog))
+ (while names
+ (setq new-subprog (cons (list (car names)) (cdr old-subprog)))
+ (setq new-subprog-list (append new-subprog-list (list new-subprog)))
+ (setq names (cdr names)))
+ (setq old-subprog-list (cdr old-subprog-list)))
+ (setq vhdl-subprog-list
+ (list (nth 0 vhdl-subprog-list) (nth 1 vhdl-subprog-list)
+ new-subprog-list (nth 3 vhdl-subprog-list)
+ (nth 4 vhdl-subprog-list) (nth 5 vhdl-subprog-list))
+ vhdl-subprog-flattened t)
+ (message "Flattening subprogram interface...done"))))
+
+(defun vhdl-subprog-copy ()
+ "Get interface information from a subprogram specification."
+ (interactive)
+ (save-excursion
+ (let (parse-error pos end-of-list
+ name kind param-list object names direct type init
+ comment group-comment
+ return-type return-comment return-group-comment)
+ (vhdl-prepare-search-2
+ (setq
+ parse-error
+ (catch 'parse
+ ;; check if within function declaration
+ (setq pos (point))
+ (end-of-line)
+ (when (looking-at "[ \t\n]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
+ (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n]*\\(\\((\\)\\|;\\|is\\>\\)" nil t)
+ (goto-char (match-end 0))
+ (save-excursion (backward-char)
+ (forward-sexp)
+ (<= pos (point))))
+ (throw 'parse "ERROR: Not within a subprogram specification"))
+ (setq name (match-string-no-properties 5))
+ (setq kind (if (match-string 2) 'procedure 'function))
+ (setq end-of-list (not (match-string 7)))
+ (message "Reading interface of subprogram \"%s\"..." name)
+ ;; parse parameter list
+ (setq group-comment (vhdl-parse-group-comment))
+ (setq end-of-list (or end-of-list
+ (vhdl-parse-string ")[ \t\n]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
+ (while (not end-of-list)
+ ;; parse object
+ (setq object
+ (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n]*" t)
+ (match-string-no-properties 1)))
+ ;; parse names (accept extended identifiers)
+ (vhdl-parse-string "\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*")
+ (setq names (list (match-string-no-properties 1)))
+ (while (vhdl-parse-string ",[ \t\n]*\\(\\w+\\|\\\\[^\\]+\\\\\\)[ \t\n]*" t)
+ (setq names (append names (list (match-string-no-properties 1)))))
+ ;; parse direction
+ (vhdl-parse-string ":[ \t\n]*")
+ (setq direct
+ (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n]+" t)
+ (match-string-no-properties 1)))
+ ;; parse type
+ (vhdl-parse-string "\\([^():;\n]+\\)")
+ (setq type (match-string-no-properties 1))
+ (setq comment nil)
+ (while (looking-at "(")
+ (setq type
+ (concat type
+ (buffer-substring-no-properties
+ (point) (progn (forward-sexp) (point)))
+ (and (vhdl-parse-string "\\([^():;\n]*\\)" t)
+ (match-string-no-properties 1)))))
+ ;; special case: closing parenthesis is on separate line
+ (when (and type (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" type))
+ (setq comment (substring type (match-beginning 2)))
+ (setq type (substring type 0 (match-beginning 1))))
+ ;; strip off trailing group-comment
+ (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" type)
+ (setq type (substring type 0 (match-end 1)))
+ ;; parse initialization expression
+ (setq init nil)
+ (when (vhdl-parse-string ":=[ \t\n]*" t)
+ (vhdl-parse-string "\\([^();\n]*\\)")
+ (setq init (match-string-no-properties 1))
+ (while (looking-at "(")
+ (setq init
+ (concat init
+ (buffer-substring-no-properties
+ (point) (progn (forward-sexp) (point)))
+ (and (vhdl-parse-string "\\([^();\n]*\\)" t)
+ (match-string-no-properties 1))))))
+ ;; special case: closing parenthesis is on separate line
+ (when (and init (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" init))
+ (setq comment (substring init (match-beginning 2)))
+ (setq init (substring init 0 (match-beginning 1)))
+ (vhdl-forward-syntactic-ws))
+ (skip-chars-forward " \t")
+ ;; parse inline comment, special case: as above, no initial.
+ (unless comment
+ (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
+ (match-string-no-properties 1))))
+ (vhdl-forward-syntactic-ws)
+ (setq end-of-list (vhdl-parse-string ")\\s-*" t))
+ ;; parse inline comment
+ (unless comment
+ (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
+ (match-string-no-properties 1))))
+ (setq return-group-comment (vhdl-parse-group-comment))
+ (vhdl-parse-string "\\(;\\|\\(is\\|\\(return\\)\\)\\>\\)\\s-*")
+ ;; parse return type
+ (when (match-string 3)
+ (vhdl-parse-string "[ \t\n]*\\(.+\\)[ \t\n]*\\(;\\|is\\>\\)\\s-*")
+ (setq return-type (match-string-no-properties 1))
+ (when (and return-type
+ (string-match "\\(\\s-*--\\s-*\\)\\(.*\\)" return-type))
+ (setq return-comment (substring return-type (match-beginning 2)))
+ (setq return-type (substring return-type 0 (match-beginning 1))))
+ ;; strip of trailing group-comment
+ (string-match "\\(\\(\\s-*\\S-+\\)+\\)\\s-*" return-type)
+ (setq return-type (substring return-type 0 (match-end 1)))
+ ;; parse return comment
+ (unless return-comment
+ (setq return-comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
+ (match-string-no-properties 1)))))
+ ;; parse inline comment
+ (unless comment
+ (setq comment (and (vhdl-parse-string "--\\s-*\\([^\n]*\\)" t)
+ (match-string-no-properties 1))))
+ ;; save everything in list
+ (setq param-list (append param-list
+ (list (list names object direct type init
+ comment group-comment))))
+ ;; parse group comment and spacing
+ (setq group-comment (vhdl-parse-group-comment)))
+ (message "Reading interface of subprogram \"%s\"...done" name)
+ nil)))
+ ;; finish parsing
+ (if parse-error
+ (error parse-error)
+ (setq vhdl-subprog-list
+ (list name kind param-list return-type return-comment
+ return-group-comment)
+ vhdl-subprog-flattened nil)))))
+
+(defun vhdl-subprog-paste-specification (kind)
+ "Paste as a subprogram specification."
+ (indent-according-to-mode)
+ (let ((margin (current-column))
+ (param-list (nth 2 vhdl-subprog-list))
+ list-margin start names param)
+ ;; paste keyword and name
+ (vhdl-insert-keyword
+ (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE " "FUNCTION "))
+ (insert (nth 0 vhdl-subprog-list))
+ (if (not param-list)
+ (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
+ (setq start (point))
+ ;; paste parameter list
+ (insert " (")
+ (unless vhdl-argument-list-indent
+ (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
+ (setq list-margin (current-column))
+ (while param-list
+ (setq param (car param-list))
+ ;; paste group comment and spacing
+ (when (memq vhdl-include-group-comments (list kind 'always))
+ (vhdl-paste-group-comment (nth 6 param) list-margin))
+ ;; paste object
+ (when (nth 1 param) (insert (nth 1 param) " "))
+ ;; paste names
+ (setq names (nth 0 param))
+ (while names
+ (insert (car names))
+ (setq names (cdr names))
+ (when names (insert ", ")))
+ ;; paste direction
+ (insert " : ")
+ (when (nth 2 param) (insert (nth 2 param) " "))
+ ;; paste type
+ (insert (nth 3 param))
+ ;; paste initialization
+ (when (nth 4 param) (insert " := " (nth 4 param)))
+ ;; terminate line
+ (if (cdr param-list)
+ (insert ";")
+ (insert ")")
+ (when (null (nth 3 vhdl-subprog-list))
+ (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))))
+ ;; paste comment
+ (when (and vhdl-include-port-comments (nth 5 param))
+ (vhdl-comment-insert-inline (nth 5 param) t))
+ (setq param-list (cdr param-list))
+ (when param-list (insert "\n") (indent-to list-margin)))
+ (when (nth 3 vhdl-subprog-list)
+ (insert "\n") (indent-to list-margin)
+ ;; paste group comment and spacing
+ (when (memq vhdl-include-group-comments (list kind 'always))
+ (vhdl-paste-group-comment (nth 5 vhdl-subprog-list) list-margin))
+ ;; paste return type
+ (insert "return " (nth 3 vhdl-subprog-list))
+ (if (eq kind 'decl) (insert ";") (vhdl-insert-keyword " is"))
+ (when (and vhdl-include-port-comments (nth 4 vhdl-subprog-list))
+ (vhdl-comment-insert-inline (nth 4 vhdl-subprog-list) t)))
+ ;; align parameter list
+ (when vhdl-auto-align (vhdl-align-region-groups start (point) 1 t)))
+ ;; paste body
+ (when (eq kind 'body)
+ (insert "\n")
+ (vhdl-template-begin-end
+ (unless (vhdl-standard-p '87)
+ (if (eq (nth 1 vhdl-subprog-list) 'procedure) "PROCEDURE" "FUNCTION"))
+ (nth 0 vhdl-subprog-list) margin))))
+
+(defun vhdl-subprog-paste-declaration ()
+ "Paste as a subprogram declaration."
+ (interactive)
+ (if (not vhdl-subprog-list)
+ (error "ERROR: No subprogram interface read")
+ (message "Pasting interface as subprogram declaration \"%s\"..."
+ (car vhdl-subprog-list))
+ ;; paste specification
+ (vhdl-subprog-paste-specification 'decl)
+ (message "Pasting interface as subprogram declaration \"%s\"...done"
+ (car vhdl-subprog-list))))
+
+(defun vhdl-subprog-paste-body ()
+ "Paste as a subprogram body."
+ (interactive)
+ (if (not vhdl-subprog-list)
+ (error "ERROR: No subprogram interface read")
+ (message "Pasting interface as subprogram body \"%s\"..."
+ (car vhdl-subprog-list))
+ ;; paste specification and body
+ (vhdl-subprog-paste-specification 'body)
+ (message "Pasting interface as subprogram body \"%s\"...done"
+ (car vhdl-subprog-list))))
+
+(defun vhdl-subprog-paste-call ()
+ "Paste as a subprogram call."
+ (interactive)
+ (if (not vhdl-subprog-list)
+ (error "ERROR: No subprogram interface read")
+ (let ((orig-vhdl-subprog-list vhdl-subprog-list)
+ param-list margin list-margin param start)
+ ;; flatten local copy of interface list (must be flat for parameter mapping)
+ (vhdl-subprog-flatten)
+ (setq param-list (nth 2 vhdl-subprog-list))
+ (indent-according-to-mode)
+ (setq margin (current-indentation))
+ (message "Pasting interface as subprogram call \"%s\"..."
+ (car vhdl-subprog-list))
+ ;; paste name
+ (insert (nth 0 vhdl-subprog-list))
+ (if (not param-list)
+ (insert ";")
+ (setq start (point))
+ ;; paste parameter list
+ (insert " (")
+ (unless vhdl-argument-list-indent
+ (insert "\n") (indent-to (+ margin vhdl-basic-offset)))
+ (setq list-margin (current-column))
+ (while param-list
+ (setq param (car param-list))
+ ;; paste group comment and spacing
+ (when (eq vhdl-include-group-comments 'always)
+ (vhdl-paste-group-comment (nth 6 param) list-margin))
+ ;; paste formal port
+ (insert (car (nth 0 param)) " => ")
+ (setq param-list (cdr param-list))
+ (insert (if param-list "," ");"))
+ ;; paste comment
+ (when (and vhdl-include-port-comments (nth 5 param))
+ (vhdl-comment-insert-inline (nth 5 param)))
+ (when param-list (insert "\n") (indent-to list-margin)))
+ ;; align parameter list
+ (when vhdl-auto-align
+ (vhdl-align-region-groups start (point) 1)))
+ (message "Pasting interface as subprogram call \"%s\"...done"
+ (car vhdl-subprog-list))
+ (setq vhdl-subprog-list orig-vhdl-subprog-list))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Miscellaneous
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Hippie expand customization
+
+(defvar vhdl-expand-upper-case nil)
+
+(defun vhdl-try-expand-abbrev (old)
+ "Try expanding abbreviations from `vhdl-abbrev-list'."
+ (unless old
+ (he-init-string (he-dabbrev-beg) (point))
+ (setq he-expand-list
+ (let ((abbrev-list vhdl-abbrev-list)
+ (sel-abbrev-list '()))
+ (while abbrev-list
+ (when (or (not (stringp (car abbrev-list)))
+ (string-match
+ (concat "^" he-search-string) (car abbrev-list)))
+ (setq sel-abbrev-list
+ (cons (car abbrev-list) sel-abbrev-list)))
+ (setq abbrev-list (cdr abbrev-list)))
+ (nreverse sel-abbrev-list))))
+ (while (and he-expand-list
+ (or (not (stringp (car he-expand-list)))
+ (he-string-member (car he-expand-list) he-tried-table t)))
+; (equal (car he-expand-list) he-search-string)))
+ (unless (stringp (car he-expand-list))
+ (setq vhdl-expand-upper-case (car he-expand-list)))
+ (setq he-expand-list (cdr he-expand-list)))
+ (if (null he-expand-list)
+ (progn (when old (he-reset-string))
+ nil)
+ (he-substitute-string
+ (if vhdl-expand-upper-case
+ (upcase (car he-expand-list))
+ (car he-expand-list))
+ t)
+ (setq he-expand-list (cdr he-expand-list))
+ t))
+
+(defun vhdl-he-list-beg ()
+ "Also looks at the word before `(' in order to better match parenthesized
+expressions (e.g. for index ranges of types and signals)."
+ (save-excursion
+ (condition-case ()
+ (progn (backward-up-list 1)
+ (skip-syntax-backward "w_")) ; crashes in `viper-mode'
+ (error ()))
+ (point)))
+
+;; override `he-list-beg' from `hippie-exp'
+(unless (and (boundp 'viper-mode) viper-mode)
+ (defalias 'he-list-beg 'vhdl-he-list-beg))
+
+;; function for expanding abbrevs and dabbrevs
+(defun vhdl-expand-abbrev (arg))
+(fset 'vhdl-expand-abbrev (make-hippie-expand-function
+ '(try-expand-dabbrev
+ try-expand-dabbrev-all-buffers
+ vhdl-try-expand-abbrev)))
+
+;; function for expanding parenthesis
+(defun vhdl-expand-paren (arg))
+(fset 'vhdl-expand-paren (make-hippie-expand-function
+ '(try-expand-list
+ try-expand-list-all-buffers)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Case fixing