Function: vhdl-subprog-copy

vhdl-subprog-copy is an interactive and byte-compiled function defined in vhdl-mode.el.gz.

Signature

(vhdl-subprog-copy)

Documentation

Get interface information from a subprogram specification.

Key Bindings

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/vhdl-mode.el.gz
(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\r\f]*\\((\\|;\\|is\\>\\)") (goto-char (match-end 0)))
	  (unless (and (re-search-backward "^\\s-*\\(\\(procedure\\)\\|\\(\\(pure\\|impure\\)\\s-+\\)?function\\)\\s-+\\(\"?\\w+\"?\\)[ \t\n\r\f]*\\(\\((\\)\\|;\\|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\r\f]*\\(;\\|\\(is\\|return\\)\\>\\)" t)))
	  (while (not end-of-list)
	    ;; parse object
	    (setq object
		  (and (vhdl-parse-string "\\(constant\\|signal\\|variable\\|file\\|quantity\\|terminal\\)[ \t\n\r\f]*" t)
			 (match-string-no-properties 1)))
	    ;; parse names (accept extended identifiers)
	    (vhdl-parse-string "\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*")
	    (setq names (list (match-string-no-properties 1)))
	    (while (vhdl-parse-string ",[ \t\n\r\f]*\\(\\\\[^\\]+\\\\\\|\\w+\\)[ \t\n\r\f]*" t)
	      (setq names (append names (list (match-string-no-properties 1)))))
	    ;; parse direction
	    (vhdl-parse-string ":[ \t\n\r\f]*")
	    (setq direct
		  (and (vhdl-parse-string "\\(in\\|out\\|inout\\|buffer\\|linkage\\)[ \t\n\r\f]+" 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\r\f]*" 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\r\f]*\\(.+\\)[ \t\n\r\f]*\\(;\\|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)))))