rayv@revenge.oakhill.uucp (Ray Voith) (02/06/91)
Peter Ashenden recently posted a vhdl-mode.el file for GNUemacs. This posting is my version. The first version of this came from Steve Grout who was at MCC. I modified it, fixed some bugs and added to it. Then I added some things Peter had which I didn't have. I changed some key bindings, although when I use it I usually issue commands using meta-x vhdl-..... If you use it, please send me any bugs/comments that will help improve it. I have not used it extensively. ------ cut here --------------------------------------------- ;;; -*- Mode: emacs-lisp; Package: USER; Base: 10; Nofill: Yes; -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Description: VHDL Mode ;;; The following was created by changing the 'ada.el' Ada-mode ;;; code which was a part of the gnu-emacs 18.50 distribution into ;;; a 'vhdl.el' vhdl-mode to support some level of electric editing ;;; and semi-automatic creation of VHDL code fragments ;;; with the GNU-EMACS text editor. ;;; Further changes will from now on be noted BELOW the original change ;;; notes of the original ada.el version. ;;; -- Steve Grout, MCC CAD Program, March 31, 1988. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ; Ada editing support package in GNUlisp. v1.0 ; Author: Vincent Broman <broman@bugs.nosc.mil> May 1987. ; (borrows heavily from Mick Jordan's Modula-2 package for GNU, ; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Modification History ;; --------------------------------------------------------------------;; ; ; 31Mar88: changed all 'ada' to 'vhdl' as first pass. jsgrout ; ; 5/25/88: Major revision with some new functions drafted, reviewing ; all functions and updating them to full 1076 VHDL. Not ; completely tested so some parts may still have problems. jgrout ; 6/8/88: Tested all functions with changes to some. All functions ; are now working tho further adjustments may be needed to make ; them more acceptable to users. jsgrout ; 9/20/90 rayv@revenge.sps.mot.com (512)-891-BANK ; ; fixed a variety of bugs ; - did not set up compile, simulate, etc. properly. ; - this is local to system anyway. ; - may be superfluous stuff in file. ; ; added: ; vhdl-entity, vhdl-selected-when, vhdl-configuration-spec ; vhdl-configuration-declaration vhdl-generate ; vhdl-attribute-declaration vhdl-attribute-spec ; vhdl-component vhdl-component-instance ; vhdl-assert vhdl-wait vhdl-process ; vhdl-conditional-signal-assignment ; vhdl-conditional-waveform ; changed key bindings: ; vhdl-find-listing to C-c C-e ; vhdl-else to C-c E ; added key bindings: ; vhdl-entity C-c e ; vhdl-architecture C-c a ; vhdl-display-comment C-c d ; changed: ; vhdl-selected-signal-assignment to do first vhdl-selected-when. ; changed name: ; get-vhdl-subprogram-name to vhdl-get-vhdl-subprogram-name. ; 01-29-91 rayv@revenge.sps.mot.com (512)-891-2AOK ; added port prompt to entity ; ; 01-31-91 rayv@revenge.sps.mot.com (512)-891-2AOK ; added some stuff from Peter Ashenden <petera@cs.ua.oz.au> file ; which appeared on the net. ; vhdl-generic-spec vhdl-port-spec vhdl-signal vhdl-variable ; vhdl-next ; added key bindings ; vhdl-component C-c C-c ; vhdl-component-instance C-c q ; vhdl-process C-c P ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;(setq auto-mode-alist (cons (cons "\\.vhdl$" 'vhdl-mode) auto-mode-alist)) ;;(setq auto-mode-alist (cons (cons "\\.vhd$" 'vhdl-mode) auto-mode-alist)) (defvar vhdl-mode-syntax-table nil "Syntax table in use in vhdl-mode buffers.") (let ((table (make-syntax-table))) (modify-syntax-entry ?_ "_" table) (modify-syntax-entry ?\# "_" table) (modify-syntax-entry ?\( "()" table) (modify-syntax-entry ?\) ")(" table) (modify-syntax-entry ?$ "." table) (modify-syntax-entry ?* "." table) (modify-syntax-entry ?/ "." table) (modify-syntax-entry ?+ "." table) (modify-syntax-entry ?- "." table) (modify-syntax-entry ?= "." table) (modify-syntax-entry ?\& "." table) (modify-syntax-entry ?\| "." table) (modify-syntax-entry ?< "." table) (modify-syntax-entry ?> "." table) (modify-syntax-entry ?\[ "." table) (modify-syntax-entry ?\] "." table) (modify-syntax-entry ?\{ "." table) (modify-syntax-entry ?\} "." table) (modify-syntax-entry ?. "." table) (modify-syntax-entry ?\\ "." table) (modify-syntax-entry ?: "." table) (modify-syntax-entry ?\; "." table) (modify-syntax-entry ?\' "." table) (modify-syntax-entry ?\" "\"" table) (setq vhdl-mode-syntax-table table)) (defvar vhdl-mode-map nil "Keymap used in vhdl mode.") ; The bindings of the below vhdl-mode probably need reorganizing so ; that they are more natural. Those currently used merely extend ; the original Ada bindings to the VHDL language editing implemented so far. jsgrout (let ((map (make-sparse-keymap))) (define-key map "\C-?" 'backward-delete-char-untabify) (define-key map "\C-ca" 'vhdl-architecture) (define-key map "\C-c\C-a" 'vhdl-array) (define-key map "\C-c<" 'vhdl-backward-to-same-indent) (define-key map "\C-cB" 'vhdl-bind) (define-key map "\C-cb" 'vhdl-block) ;;*** was \C-cd in Grout (define-key map "\C-cc" 'vhdl-case) (define-key map "\C-cC" 'vhdl-compile) (define-key map "\C-c\C-c" 'vhdl-component) (define-key map "\C-cq" 'vhdl-component-instance) (define-key map "\C-cd" 'vhdl-display-comment) (define-key map "\C-cE" 'vhdl-else) ;;;**************** was \C-ce (define-key map "\C-cI" 'vhdl-elsif) (define-key map "\C-ce" 'vhdl-entity) ;;;****** was \C-c\C-e (define-key map "\C-cx" 'vhdl-exit) (define-key map "\C-c\C-e" 'vhdl-find-listing) ;;was "\C-cE" (define-key map "\C-cf" 'vhdl-for-loop) (define-key map "\C-c>" 'vhdl-forward-to-same-indent) (define-key map "\C-c\C-f" 'vhdl-function-spec) (define-key map "\C-c\C-g" 'vhdl-generic-spec) (define-key map "\C-ch" 'vhdl-header) (define-key map "\C-ci" 'vhdl-if) (define-key map "\C-c-" 'vhdl-inline-comment) (define-key map "\C-cL" 'vhdl-library-name) (define-key map "\C-cl" 'vhdl-loop) (define-key map "\C-m" 'vhdl-newline) (define-key map "\C-cn" 'vhdl-next) (define-key map "\C-ck" 'vhdl-package-body) (define-key map "\C-c\C-k" 'vhdl-package-spec) (define-key map "\C-c(" 'vhdl-paired-parens) (define-key map "\C-c\C-h" 'vhdl-port-spec) (define-key map "\C-cp" 'vhdl-procedure-body) (define-key map "\C-c\C-p" 'vhdl-procedure-spec) (define-key map "\C-cP" 'vhdl-process) (define-key map "\C-c\C-r" 'vhdl-record) (define-key map "\C-cW" 'vhdl-selected-signal-assignment) (define-key map "\C-cO" 'vhdl-set-options) (define-key map "\C-cs" 'vhdl-signal) (define-key map "\C-c\C-s" 'vhdl-subtype) (define-key map "\C-i" 'vhdl-tab) (define-key map "\C-ct" 'vhdl-tabsize) (define-key map "\C-c\C-t" 'vhdl-type) (define-key map "\C-c\C-i" 'vhdl-untab) (define-key map "\C-c\C-u" 'vhdl-use) (define-key map "\C-cv" 'vhdl-variable) (define-key map "\C-c\C-w" 'vhdl-when) (define-key map "\C-cw" 'vhdl-while-loop) (setq vhdl-mode-map map)) (defvar vhdl-indent 4 "*Value is the number of columns to indent in vhdl-Mode.") (defun vhdl-mode () "This is a mode intended to support program development in vhdl. Most control constructs and declarations of vhdl can be inserted in the buffer by typing Control-C followed by a character mnemonic for the construct. #* ==> not in aus #** ==> new binding key ------- --- vhdl-analyze #* vhdl-architecture C-c a vhdl-array C-c C-a vhdl-assert #** vhdl-attribute-declaration #** vhdl-attribute-spec #** vhdl-backward-to-same-indent C-c < (subsidiary) vhdl-bind C-c B vhdl-block C-c b ;;*** was C-c d (orig) vhdl-case (vhdl-when) C-c c (C-c C-w) vhdl-compile C-c C vhdl-component --v C-c C-c vhdl-component-instance #** --^ C-c q vhdl-conditional-signal-assignment #**--v vhdl-conditional-waveform #** --^ vhdl-configuration-declaration #** vhdl-configuration-spec #** vhdl-display-comment C-c d vhdl-elaborate #* vhdl-else C-c E ;;*** was C-c e vhdl-elsif C-c I vhdl-entity(vhdl-generic..)(vhdl-port..)C-c e (C-c C-g)(C-c C-h);;*** was C-c C-e vhdl-exit C-c x vhdl-find-listing C-c C-e ;;*** was C-c E vhdl-for-loop (vhdl-next) (vhdl-exit) C-c f (C-c n) (C-c x) vhdl-forward-to-same-indent C-c > (subsidiary) vhdl-function-body #** vhdl-function-spec C-c C-f vhdl-generate #** vhdl-generic-spec C-c C-g vhdl-get-arg-list (subsidiary) vhdl-get-vhdl-subprogram-name (subsidiary) vhdl-go-to-this-indent (subsidiary) vhdl-header C-c h vhdl-if(vhdl-elsif)(vhdl-else) C-c i (C-c I) (C-c E) vhdl-inline-comment C-c - vhdl-library-name C-c L (subsidiary) vhdl-loop (vhdl-exit) (vhdl-exit) C-c l (C-c n) (C-c x) vhdl-mode vhdl-newline RET (C-m) vhdl-next C-c n vhdl-package-body C-c k vhdl-package-spec C-c C-k vhdl-paired-parens C-c ( vhdl-port-spec C-c C-h vhdl-procedure-body #** C-c p vhdl-procedure-spec C-c C-p vhdl-process C-c P vhdl-record C-c C-r vhdl-selected-signal-assignment #* --v C-c W vhdl-selected-when #** --^ vhdl-set-options #* C-c O vhdl-signal C-c s vhdl-simulate #* vhdl-subtype C-c C-s vhdl-tab TAB (C-i) vhdl-tabsize C-c t vhdl-type C-c C-t vhdl-untab C-c C-i (C-c TAB) vhdl-untab DEL vhdl-untab (backward-delete-char-untabify) (C-?) vhdl-use #* C-c C-u vhdl-variable C-c v vhdl-wait #** vhdl-when C-c C-w vhdl-while-loop (vhdl-next) (vhdl-exit) C-c w (C-c n) (C-c x) \\{vhdl-mode-map} " (interactive) (kill-all-local-variables) (use-local-map vhdl-mode-map) (setq major-mode 'vhdl-mode) (setq mode-name "vhdl") (make-local-variable 'comment-column) (setq comment-column 41) (make-local-variable 'end-comment-column) (setq end-comment-column 72) (set-syntax-table vhdl-mode-syntax-table) (make-local-variable 'paragraph-start) (setq paragraph-start (concat "^$\\|" page-delimiter)) (make-local-variable 'paragraph-separate) (setq paragraph-separate paragraph-start) (make-local-variable 'require-final-newline) (setq require-final-newline t) (make-local-variable 'comment-start) (setq comment-start "--") (make-local-variable 'comment-end) (setq comment-end "\n") (make-local-variable 'comment-column) (setq comment-column 41) (make-local-variable 'comment-start-skip) (setq comment-start-skip "--+ *") (make-local-variable 'comment-indent-hook) (setq comment-indent-hook 'c-comment-indent) (make-local-variable 'parse-sexp-ignore-comments) (setq parse-sexp-ignore-comments t) (run-hooks 'vhdl-mode-hook)) ;; ;;---------------------------------------------------------------- ;; (defun vhdl-architecture () "Insert architecture, prompting for name and related entity" (interactive) (let ( (vhdl-architecture-name (read-string "[architecture name]: ")) (vhdl-entity-name (read-string "[entity name]: "))) (insert "architecture ") (insert vhdl-architecture-name " of ") (insert vhdl-entity-name " is") (vhdl-newline) (vhdl-newline) (insert "begin") (vhdl-newline) (vhdl-newline) (insert "end " vhdl-architecture-name " ;")) (end-of-line 0) (vhdl-tab) (end-of-line -1) (vhdl-tab) ) ;;---------------------------------------------------- (defun vhdl-array () "Insert array type definition, prompting for component type, leaving the user to type in the index subtypes." (interactive) (insert "array ()") (backward-char) (insert (read-string "range[s]: ")) (forward-char) (insert " of ;") (backward-char) (insert (read-string "component-type: ")) (end-of-line)) ;;---------------------------------------------------- (defun vhdl-assert () "Inserts a assert skeleton" (interactive) (insert "assert " (read-string "boolean-expression: ")) (vhdl-newline) (vhdl-tab) (insert "report ") (insert (read-string "string-expression: ")) (vhdl-newline) (insert "severity ") (insert (read-string "note, warning, error, failure: ") ";") ) ;;---------------------------------------------------- (defun vhdl-attribute-declaration () "Inserts a attribute-declaration skeleton" (interactive) (insert "attribute " (read-string "attribute name: ") " : ") (insert (read-string "type-mark: ") " ;") ) ;;---------------------------------------------------- (defun vhdl-attribute-spec () "Inserts a attribute-spec skeleton" (interactive) (insert "attribute " (read-string "attribute name: ") " of ") (insert (read-string "entity-name-list: ") " : ") (insert (read-string "entity-class: ") " is") (vhdl-newline) (vhdl-tab) (insert (read-string "enter expression: ") ";") ) ;;---------------------------------------------------- (defun vhdl-backward-to-same-indent () "Move point backwards to nearest line with same indentation or less. If not found, point is left at top of buffer." (interactive) (vhdl-go-to-this-indent -1 (current-indentation)) (back-to-indentation)) ;;---------------------------------------------------- (defun vhdl-block () "Insert a block and indent for the 1st declaration." (interactive) (let ((vhdl-block-name (read-string "[block name]: "))) (insert vhdl-block-name ":") (vhdl-newline) (insert "block ") (let ((guard-exp (read-string "[guard expression]: "))) (if (not (string-equal guard-exp "")) (insert " (" guard-exp ")"))) ;; handle generic and port stuff here ;;^^^^;;;;; (vhdl-newline) (vhdl-newline) (insert "begin") (vhdl-newline) (vhdl-newline) (insert "end block " vhdl-block-name " ;")) ;; end let (end-of-line 0) (vhdl-tab) (end-of-line -1) (vhdl-tab)) ;;---------------------------------------------------- (defun vhdl-case () "Build skeleton case statement, prompting for the selector expression. starts up the first when clause, too." (interactive) (insert "case ") (insert (read-string "selector expression: ") " is") (vhdl-newline) (vhdl-newline) (insert "end case;") (end-of-line 0) (vhdl-tab) (vhdl-tab) (vhdl-when)) ;;---------------------------------------------------- (defun vhdl-component () "Inserts a component skeleton" (interactive) (insert "component " (read-string "component-name: ")) (vhdl-newline) ;; change to make generics and port optional ;;^^^^;;;;;;;;; (let ((vhdl-arg-indent (current-column))) (vhdl-tab) (insert "-- generic ();") (vhdl-newline) (insert "port ") (vhdl-get-arg-list) (end-of-line) (insert ";") (newline) (indent-to vhdl-arg-indent)) (insert "end component;") ) ;;---------------------------------------------------- (defun vhdl-component-instance () "Inserts a component-instance skeleton" (interactive) (insert (read-string "instance name: ") " : ") (insert (read-string "component-type: ")) (vhdl-newline) (vhdl-tab) (insert "-- generic map ()") (vhdl-newline) (insert "port map (") (insert (read-string "association-list: ") ");") ) ;;---------------------------------------------------- (defun vhdl-conditional-signal-assignment () "Inserts a conditional-signal-assignment skeleton" (interactive) (insert (read-string "target: ") " <= ") (insert (read-string "options (guarded | transport): ")) (vhdl-newline) (vhdl-tab) (vhdl-conditional-waveform) (insert ";") (backward-char) ) ;;---------------------------------------------------- (defun vhdl-conditional-waveform () "Inserts a conditional-signal-assignment waveform." (interactive) (insert (read-string "<expr[after time]>+ when boolean-expr [else]: ")) (vhdl-newline) ) ;;---------------------------------------------------- (defun vhdl-configuration-declaration () "Inserts a configuration-declaration skeleton" (interactive) (insert "configuration ") (let ((name (read-string "name: "))) (insert name " of ") (insert (read-string "item to be configured: ") " is") (vhdl-newline) (vhdl-newline) (insert "end " name ";")) (end-of-line 0) (vhdl-tab) ) ;;---------------------------------------------------- (defun vhdl-configuration-spec () "Inserts a configuration-spec skeleton" (interactive) (insert "for ") (insert (read-string "list of components: ") ": ") (insert (read-string "component type: ") " use entity ") (insert (read-string "lib.entity(arch): ")) (vhdl-newline) (vhdl-tab) (insert "-- generic map ()") (vhdl-newline) (insert "-- port map ()") (vhdl-newline) (insert ";") ) ;;---------------------------------------------------- (defun vhdl-display-comment () "Inserts 3 comment lines, making a display comment." (interactive) (insert "--\n-- \n--") (end-of-line 0)) ;;---------------------------------------------------- (defun vhdl-else () "Add an else clause inside an if-then-end-if clause." (interactive) (vhdl-newline) (vhdl-untab) (insert "else") (vhdl-newline) (vhdl-tab)) ;;---------------------------------------------------- (defun vhdl-elsif () "Add an elsif clause to an if statement, prompting for the boolean-expression." (interactive) (vhdl-newline) (vhdl-untab) (insert "elsif ") (insert (read-string "condition: ") " then") (vhdl-newline) (vhdl-tab)) ;;---------------------------------------------------- (defun vhdl-entity () "Insert entity, prompting for name" (interactive) (let ( (vhdl-entity-name (read-string "[entity name]: "))) (insert "entity ") (insert vhdl-entity-name " is") (vhdl-newline) ;; change next parts to prompt for optional generics and ports ;;^^^^;; (vhdl-tab) (insert "-- generic ();") (vhdl-newline) (insert "port ") (vhdl-get-arg-list) (end-of-line) (insert ";") (newline) (vhdl-newline) (insert "begin") (vhdl-newline) (vhdl-newline) (insert "end " vhdl-entity-name " ;") (vhdl-newline)) (end-of-line -1) (vhdl-tab) (end-of-line -1) (vhdl-tab) (end-of-line 3) ) ;;---------------------------------------------------- (defun vhdl-exit () "Insert an exit statement, prompting for loop name and condition." (interactive) (insert "exit") (let ((vhdl-loop-name (read-string "[name of loop to exit]: "))) (if (not (string-equal vhdl-loop-name "")) (insert " " vhdl-loop-name))) (let ((vhdl-exit-condition (read-string "[exit condition]: "))) (if (not (string-equal vhdl-exit-condition "")) (if (string-match "^ *[Ww][Hh][Ee][Nn] +" vhdl-exit-condition) (insert " " vhdl-exit-condition) (insert " when " vhdl-exit-condition)))) (insert ";")) ;;---------------------------------------------------- (defun vhdl-for-loop () "Build a skeleton for-loop statement, prompting for the loop parameters." (interactive) (insert "for ") (let* ((vhdl-loop-name (read-string "[loop name]: ")) (vhdl-loop-is-named (not (string-equal vhdl-loop-name "")))) (if vhdl-loop-is-named (progn (beginning-of-line) (open-line 1) (insert vhdl-loop-name ":") (next-line 1) (end-of-line 1))) (insert (read-string "loop variable: ") " in ") (insert (read-string "range: ") " loop") (vhdl-newline) (vhdl-newline) (insert "end loop") (if vhdl-loop-is-named (insert " " vhdl-loop-name)) (insert ";")) (end-of-line 0) (vhdl-tab)) ;;---------------------------------------------------- (defun vhdl-forward-to-same-indent () "Move point forwards to nearest line with same indentation or less. If not found, point is left at start of last line in buffer." (interactive) (vhdl-go-to-this-indent 1 (current-indentation)) (back-to-indentation)) ;;---------------------------------------------------- (defun vhdl-function-body () "Insert frame for function body." (interactive) (insert "function ") (insert (read-string "function name: ")) (vhdl-get-arg-list) (insert " return ") (insert (read-string "result typemark: ")) (insert " is") (let ((vhdl-subprogram-name-col (vhdl-get-vhdl-subprogram-name))) (newline) (indent-to (cdr vhdl-subprogram-name-col)) (vhdl-newline) (insert "begin") (vhdl-newline) (vhdl-newline) (insert "end " (car vhdl-subprogram-name-col) ";")) (end-of-line 0) (vhdl-tab) (end-of-line -1) (vhdl-tab)) ;;---------------------------------------------------- (defun vhdl-function-spec () "Insert a function specification. Prompts for name and arguments." (interactive) (insert "function ") (insert (read-string "function name: ")) (vhdl-get-arg-list) (insert " return ") (insert (read-string "result typemark: ") ";") (vhdl-newline)) ;;---------------------------------------------------- (defun vhdl-generate () "Inserts a generate skeleton - ****** set up if or for scheme" (interactive) (let ((label (read-string "label: "))) (insert label ": ") (insert (read-string "generate-scheme: ") " generate") (vhdl-newline) (vhdl-newline) (insert "end generate " label ";")) (end-of-line 0) (vhdl-tab) ) ;;---------------------------------------------------- (defun vhdl-generic-spec () "Insert a generic specification, prompting for arguments." (interactive) (insert "generic") (vhdl-get-arg-list) (insert ";")) ;;---------------------------------------------------- (defun vhdl-get-arg-list () "Read from user a procedure or function argument list. Add parens unless arguments absent, and insert into buffer. Individual arguments are arranged vertically if entered one-at-a-time. Arguments ending with ';' are presumed single and stacked." (insert " (") (let ((vhdl-arg-indent (current-column)) (vhdl-args (read-string "[arguments]: "))) (if (string-equal vhdl-args "") (backward-delete-char 2) (progn (while (string-match ";$" vhdl-args) (insert vhdl-args) (newline) (indent-to vhdl-arg-indent) (setq vhdl-args (read-string "next argument: "))) (insert vhdl-args ")"))))) ;;---------------------------------------------------- (defun vhdl-get-vhdl-subprogram-name () "Return (without moving point or mark) a pair whose CAR is the name of the function or procedure whose spec immediately precedes point, and whose CDR is the column nbr the procedure/function keyword was found at." (save-excursion (let ((vhdl-proc-indent 0)) (if (re-search-backward ;;;; Unfortunately, comments are not ignored in this string search. "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" nil t) (if (or (looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>") (looking-at "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>")) (progn (setq vhdl-proc-indent (current-column)) (forward-word 2) (let ((p2 (point))) (forward-word -1) (cons (buffer-substring (point) p2) vhdl-proc-indent))) (vhdl-get-vhdl-subprogram-name)) (cons "NAME?" vhdl-proc-indent))))) ;;---------------------------------------------------- (defun vhdl-go-to-this-indent (step indent-level) "Move point repeatedly by <step> lines till the current line has given indent-level or less, or the start/end of the buffer is hit. Ignore blank lines, statement labels, block/loop names." (while (and (zerop (forward-line step)) (or (looking-at "^[ ]*$") (looking-at "^[ ]*--") (looking-at "^<<[A-Za-z0-9_]+>>") (looking-at "^[A-Za-z0-9_]+:") (> (current-indentation) indent-level))) nil)) ;;---------------------------------------------------- (defun vhdl-header () "Insert a comment block containing the module title, author, etc." (interactive) (insert "-- ******************************************************************") (insert "\n-- Copyright (C) 1991 - , XXXXXXXX Inc.") (insert "\n-- ******************************************************************") (insert "\n--\n-- Title:\t" (read-string "Title: ")) (insert "\n--") (insert "\n-- Author:\t" (user-full-name)) (insert "\t<" (user-login-name) "@" (system-name) ".sps.mot.com>") (insert "\n--") (insert "\n-- Created:\t" (current-time-string)) (insert "\n-- Released:\t") (insert "\n--") (insert "\n-- VHDL:\tIEEE Std 1076") (insert "\n--") (insert "\n-- Keywords:\t" (read-string "Enter keywords: ")) (insert "\n-- Abstract:\t" (read-string "Describe the purpose of the VHDL: ")) (insert "\n--") (insert "\n-- Modifications:") (insert "\n-- DATE AUTHOR HISTORY") (insert "\n-- ") (insert "\n-- ******************************************************************") (insert "\n--") (insert "\n-- Distribution and Copyright:") (insert "\n-- This Header must be included in all copies of this VHDL code.") (insert "\n-- Restrictions on use or distribution: " (read-string "Enter Restrictions: ")) (insert "\n--") (insert "\n-- Disclaimer:") (insert "\n-- This VHDL description code and its documentation are provided") (insert "\n-- \"AS IS\" and without any expressed or implied warranties") (insert "\n-- whatsoever. No warranties as to performance, merchantability,") (insert "\n-- or fitness for a particular purpose exist.") (insert "\n-- ") (insert "\n-- Because of the diversity of conditions under which this code") (insert "\n-- may be used, no warranty of fitness for a particular purpose") (insert "\n-- is offered. The user is advised to evaluate the code") (insert "\n-- thoroughly before relying on it. The user must assume the") (insert "\n-- entire risk and liability of using this code.") (insert "\n-- ") (insert "\n-- In no event shall any person or organization of people be") (insert "\n-- held responsible for any direct, indirect, consequential") (insert "\n-- or inconsequential damages or lost profits.") (insert "\n-- ******************************************************************") (insert "\n\n")) ;;---------------------------------------------------- (defun vhdl-if () "Insert skeleton if statement, prompting for a boolean-expression." (interactive) (insert "if ") (insert (read-string "condition: ") " then") (vhdl-newline) (vhdl-newline) (insert "end if;") (end-of-line 0) (vhdl-tab)) ;;---------------------------------------------------- (defun vhdl-inline-comment () "Start a comment after the end of the line, indented at least COMMENT-COLUMN. If starting after END-COMMENT-COLUMN, start a new line." (interactive) (end-of-line) (if (> (current-column) end-comment-column) (newline)) (if (< (current-column) comment-column) (indent-to comment-column)) (insert " -- ")) ;;---------------------------------------------------- (defun vhdl-loop () "insert a skeleton loop statement. exit statement added by hand." (interactive) (insert "loop ") (let* ((vhdl-loop-name (read-string "[loop name]: ")) (vhdl-loop-is-named (not (string-equal vhdl-loop-name "")))) (if vhdl-loop-is-named (progn (beginning-of-line) (open-line 1) (insert vhdl-loop-name ":") (forward-line 1) (end-of-line 1))) (vhdl-newline) (vhdl-newline) (insert "end loop") (if vhdl-loop-is-named (insert " " vhdl-loop-name)) (insert ";")) (end-of-line 0) (vhdl-tab)) ;;---------------------------------------------------- (defun vhdl-newline () "Start new line and indent to current tab stop." (interactive) (let ((vhdl-cc (current-indentation))) (newline) (indent-to vhdl-cc))) ;;---------------------------------------------------- (defun vhdl-next () "Insert a next statement, prompting for loop name and condition." (interactive) (insert "next") (let ((vhdl-loop-name (read-string "[name of loop]: "))) (if (not (string-equal vhdl-loop-name "")) (insert " " vhdl-loop-name))) (let ((vhdl-next-condition (read-string "[condition]: "))) (if (not (string-equal vhdl-next-condition "")) (if (string-match "^ *[Ww][Hh][Ee][Nn] +" vhdl-next-condition) (insert " " vhdl-next-condition) (insert " when " vhdl-next-condition)))) (insert ";")) ;;---------------------------------------------------- (defun vhdl-package-body () "Insert a skeleton package body." (interactive) (insert "package body ") (let ((vhdl-package-name (read-string "package name: " ))) (insert vhdl-package-name " is") (vhdl-newline) (vhdl-newline) (insert "end " vhdl-package-name ";") (end-of-line 0) (vhdl-tab))) ;;---------------------------------------------------- (defun vhdl-package-spec () "Insert a skeleton package specification." (interactive) (insert "package ") (let ((vhdl-package-name (read-string "package name: " ))) (insert vhdl-package-name " is") (vhdl-newline) (vhdl-newline) (insert "end " vhdl-package-name ";") (end-of-line 0) (vhdl-tab))) ;;---------------------------------------------------- (defun vhdl-paired-parens () "Insert a pair of round parentheses, placing point between them." (interactive) (insert "()") (backward-char)) ;;---------------------------------------------------- (defun vhdl-port-spec () "Insert a port specification, prompting for arguments." (interactive) (insert "port") (vhdl-get-arg-list) (insert ";")) ;;---------------------------------------------------- (defun vhdl-procedure-body () "Insert frame for procedure body." (interactive) (insert "procedure ") (insert (read-string "procedure name: " )) (vhdl-get-arg-list) (insert " is") (let ((vhdl-subprogram-name-col (vhdl-get-vhdl-subprogram-name))) (newline) (indent-to (cdr vhdl-subprogram-name-col)) (vhdl-newline) (insert "begin") (vhdl-newline) (vhdl-newline) (insert "end " (car vhdl-subprogram-name-col) ";")) (end-of-line 0) (vhdl-tab) (end-of-line -1) (vhdl-tab)) ;;---------------------------------------------------- (defun vhdl-procedure-spec () "Insert a procedure specification, prompting for its name and arguments." (interactive) (insert "procedure ") (insert (read-string "procedure name: " )) (vhdl-get-arg-list)) ;;---------------------------------------------------- (defun vhdl-process () "Inserts a process skeleton" (interactive) (insert "process ") (let* ((vhdl-proc-name (read-string "process label: ")) (vhdl-proc-is-named (not (string-equal vhdl-proc-name "")))) (if vhdl-proc-is-named (progn (beginning-of-line) (open-line 1) (indent-to (current-indentation)) (insert vhdl-proc-name ":") (next-line 1) (end-of-line 1))) (let ((vhdl-sens-list (read-string "sensitivity-list: "))) (if (not (string-equal vhdl-sens-list "")) (insert "(" vhdl-sens-list ")")) ) (vhdl-newline) (vhdl-newline) (insert "begin") (vhdl-newline) (vhdl-newline) (insert "end process") (if vhdl-proc-is-named (insert " " vhdl-proc-name)) (insert ";")) (end-of-line 0) (vhdl-tab) (end-of-line -1) (vhdl-tab) ) ;;---------------------------------------------------- (defun vhdl-record () "Insert a skeleton record type declaration." (interactive) (insert "record") (vhdl-newline) (vhdl-newline) (insert "end record") (end-of-line 0) (vhdl-tab)) ;;---------------------------------------------------- (defun vhdl-selected-signal-assignment () "Inserts a selected signal assignment. Does first vhdl-selected-when" (interactive) (insert "with " (read-string "selector expression: ") " select") (vhdl-newline) (vhdl-tab) (insert (read-string "target signal: ") " <= ") (let ((opstring (read-string "options (guarded | transport): "))) (if (not (string-equal opstring "")) (insert opstring))) (vhdl-newline) (vhdl-tab) (vhdl-selected-when) (vhdl-newline) (insert ";") (end-of-line 0) ) ;;---------------------------------------------------- (defun vhdl-selected-when () "Inserts a when section into a selected signal assignment." (interactive) (insert (read-string "waveform1: ") " when ") (insert (read-string "choices1 [,]: ")) (vhdl-newline) ) ;;---------------------------------------------------- (defun vhdl-signal () "Insert a signal declaration." (interactive) (insert "signal ") (insert (read-string "signal names[s]: ") " : ") (insert (read-string "signal subtype: ")) (let ((initial-value (read-string "initial value: "))) (if (not (string-equal initial-value "")) (insert " := " initial-value))) (insert ";")) ;;---------------------------------------------------- (defun vhdl-subtype () "Start insertion of a subtype declaration, prompting for the subtype name." (interactive) (insert "subtype " (read-string "subtype name: ") " is ") (insert (read-string "insert subtype indication, and resolution function: ") ";")) ;;---------------------------------------------------- (defun vhdl-tab () "Indent to next tab stop." (interactive) (indent-to (* (1+ (/ (current-indentation) vhdl-indent)) vhdl-indent))) ;;---------------------------------------------------- (defun vhdl-tabsize (s) "changes spacing used for indentation. Reads spacing from minibuffer." (interactive "nnew indentation spacing: ") (setq vhdl-indent s)) ;;---------------------------------------------------- (defun vhdl-type () "Start insertion of a type declaration, prompting for the type name." (interactive) (insert "type " (read-string "type name: ")) (insert " is ;") (message "insert type definition: ") (backward-char 1)) ;;---------------------------------------------------- (defun vhdl-untab () "Delete backwards to previous tab stop." (interactive) (backward-delete-char-untabify vhdl-indent nil)) ;;---------------------------------------------------- (defun vhdl-use () "Inserts a use clause, prompting for the list of packages used." (interactive) (insert "use ") (insert (read-string "list of packages to use: ") ";")) ;;---------------------------------------------------- (defun vhdl-variable () "Insert a variable declaration." (interactive) (insert "variable ") (insert (read-string "variable names[s]: ") " : ") (insert (read-string "variable subtype: ")) (let ((initial-value (read-string "initial value: "))) (if (not (string-equal initial-value "")) (insert " := " initial-value))) (insert ";")) ;;---------------------------------------------------- (defun vhdl-wait () "Inserts a wait skeleton" (interactive) (insert "wait ") (insert (read-string "<on sensitivity-list | until boolean-expression | for time expression>*: ") ";") ) ;;---------------------------------------------------- (defun vhdl-when () "Start a case statement alternative with a when clause." (interactive) (vhdl-newline) (vhdl-untab) ; we were indented in code for last alternative. (insert "when ") (insert (read-string "'|'-delimited choice list: ") " =>") (vhdl-newline) (vhdl-tab)) ;;---------------------------------------------------- (defun vhdl-while-loop () (interactive) (insert "while ") (let* ((vhdl-loop-name (read-string "loop name: ")) (vhdl-loop-is-named (not (string-equal vhdl-loop-name "")))) (if vhdl-loop-is-named (progn (beginning-of-line) (open-line 1) (insert vhdl-loop-name ":") (next-line 1) (end-of-line 1))) (insert (read-string "entry condition: ") " loop") (vhdl-newline) (vhdl-newline) (insert "end loop") (if vhdl-loop-is-named (insert " " vhdl-loop-name)) (insert ";")) (end-of-line 0) (vhdl-tab)) ;;---------------------------------------------------- ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The below functions assume a given set of executables which ;; must be used to analyze, compile, elaborate, bind, and simulate ;; a VHDL description. Local tailoring will obviously be needed AR. jsgrout ;;---------------------------------------------------- (defvar vhdl-lib-dir-name "lib" "*Current vhdl program library directory.") (defvar vhdl-analyzer-opts "" "*Options to supply for analyzing.") (defvar vhdl-compile-opts "" "*Options to supply for compiling.") (defvar vhdl-bind-opts "" "*Options to supply for binding.") (defvar vhdl-elaborate-opts "" "*Options to supply for elaborating.") (defvar vhdl-simulate-opts "" "*Options to supply for simulating.") ;;---------------------------------------------------- (defun vhdl-analyze (vhdl-prefix-arg) "Save the current buffer and analyze it into the current program library. Initialize the library if a prefix arg is given." (interactive "P") (let* ((vhdl-init (if (null vhdl-prefix-arg) "" "-n ")) (vhdl-source-file (buffer-name))) (compile (concat ;; "vhdlcomp " ;; enter the name of the executable here "va" vhdl-init "-i " vhdl-source-file vhdl-lib-dir-name " " )))) ;;---------------------------------------------------- (defun vhdl-bind () "Bind the current program library, using the current binding options." (interactive) (compile (concat "vhdlbind " vhdl-bind-opts " " vhdl-lib-dir-name ))) ;;---------------------------------------------------- (defun vhdl-compile (vhdl-prefix-arg) "Save the current buffer and compile it into the current program library. Initialize the library if a prefix arg is given." (interactive "P") (let* ((vhdl-init (if (null vhdl-prefix-arg) "" "-n ")) (vhdl-source-file (buffer-name))) (compile ;;;;^^^^;;;;;;;;;;;;;;;;;;;;;;;;;; change (concat ;; "vhdlcomp " ;; "va" "vhdlan" vhdl-init "-l " vhdl-lib-dir-name " " vhdl-source-file)))) ;;---------------------------------------------------- (defun vhdl-elaborate () "Elaborate the current program library, using the current binding options." (interactive) (compile (concat "vhdlelaborate " vhdl-elaborate-opts " " vhdl-lib-dir-name ))) ;;---------------------------------------------------- (defun vhdl-find-listing () "Find listing file for vhdl source in current buffer, using other window." (interactive) (find-file-other-window (concat (substring (buffer-name) 0 -4) ".lis")) ;; (search-forward "*** ERROR") ;;;;^^^^;;;;;;;;;;;;;;;;;;;;other had (search-forward "**** ") ) ;;---------------------------------------------------- (defun vhdl-library-name (vhdl-lib-name) "Specify name of vhdl library directory for later compilations." (interactive "Dname of vhdl library directory: ") (setq vhdl-lib-dir-name vhdl-lib-name)) ;;---------------------------------------------------- (defun vhdl-set-options () "Specify options, such as -m and -i, needed for various options: vhdl-analyze, vhdl-compile, vhdl-bind, vhdl-elaborate and vhdl-simulate." (interactive) (setq vhdl-analyzer-opts (read-string "-m and -i options for vhdl-analyze: ")) (setq vhdl-compile-opts (read-string "-m and -i options for vhdl-compile: ")) (setq vhdl-bind-opts (read-string "-m and -i options for vhdl-bind: ")) (setq vhdl-elaborate-opts (read-string "-m and -i options for vhdl-elaborate: ")) (setq vhdl-simulate-opts (read-string "-m and -i options for vhdl-simulate: ")) ) ;;---------------------------------------------------- (defun vhdl-simulate () "Simulate the current program library, using the current binding options." (interactive) (compile (concat "vhdlsimulate " vhdl-simulate-opts " " vhdl-lib-dir-name ))) ;;----------------------------------------------------