petera@chook.adelaide.edu.au (Peter Ashenden) (01/31/91)
Here is the VHDL mode that I use. There are a few minor details I would
clean up if I got around to it. You know what it's like...
----------------------------------------------------------------
Peter J. Ashenden
Dept. Computer Science, University of Adelaide, South Australia
----< cut here and you'll destroy your screen!!>----------------
; VHDL editing support package in GNUlisp.
; adapted by Peter Ashenden <petera@cs.ua.oz.au> from ...
; 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.)
(setq auto-mode-alist
(append (list (cons "\\.vhd$" 'vhdl-mode) (cons "\\.vhdl$" '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.")
(let ((map (make-sparse-keymap)))
(define-key map "\C-m" 'vhdl-newline)
(define-key map "\C-?" 'backward-delete-char-untabify)
(define-key map "\C-i" 'vhdl-tab)
(define-key map "\C-c\C-i" 'vhdl-untab)
(define-key map "\C-c<" 'vhdl-backward-to-same-indent)
(define-key map "\C-c>" 'vhdl-forward-to-same-indent)
(define-key map "\C-ch" 'vhdl-header)
(define-key map "\C-c(" 'vhdl-paired-parens)
(define-key map "\C-c-" 'vhdl-inline-comment)
(define-key map "\C-c\C-a" 'vhdl-array)
(define-key map "\C-ca" 'vhdl-architecture)
(define-key map "\C-cb" 'vhdl-block)
(define-key map "\C-cP" 'vhdl-process)
(define-key map "\C-cc" 'vhdl-case)
(define-key map "\C-c\C-e" 'vhdl-entity-spec)
(define-key map "\C-c\C-c" 'vhdl-component-spec)
(define-key map "\C-c\C-k" 'vhdl-package-spec)
(define-key map "\C-ck" 'vhdl-package-body)
(define-key map "\C-c\C-p" 'vhdl-procedure-spec)
(define-key map "\C-cp" 'vhdl-subprogram-body)
(define-key map "\C-c\C-f" 'vhdl-function-spec)
(define-key map "\C-c\C-g" 'vhdl-generic-spec)
(define-key map "\C-c\C-h" 'vhdl-port-spec)
(define-key map "\C-cf" 'vhdl-for-loop)
(define-key map "\C-cl" 'vhdl-loop)
(define-key map "\C-cn" 'vhdl-next)
(define-key map "\C-ci" 'vhdl-if)
(define-key map "\C-cI" 'vhdl-elsif)
(define-key map "\C-ce" 'vhdl-else)
(define-key map "\C-c\C-r" 'vhdl-record)
(define-key map "\C-c\C-s" 'vhdl-subtype)
(define-key map "\C-c\C-t" 'vhdl-type)
(define-key map "\C-ct" 'vhdl-tabsize)
(define-key map "\C-cw" 'vhdl-while-loop)
(define-key map "\C-c\C-w" 'vhdl-when)
(define-key map "\C-cx" 'vhdl-exit)
(define-key map "\C-cs" 'vhdl-signal)
(define-key map "\C-cv" 'vhdl-variable)
(define-key map "\C-cC" 'vhdl-compile)
(define-key map "\C-cB" 'vhdl-bind)
(define-key map "\C-cE" 'vhdl-find-listing)
(define-key map "\C-cL" 'vhdl-library-name)
(define-key map "\C-cO" 'vhdl-options-for-bind)
(define-key map "\C-c\C-l" 'goto-line)
(setq vhdl-mode-map map))
(defvar vhdl-indent 2 "*Value is the number of columns to indent in
vhdl-Mode.")
(defun vhdl-mode ()
"This is a mode intended to support model 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.
C-c C-a array C-c a architecture
C-c b block
C-c C-c component spec C-c c case
C-c C-e entity spec C-c e else
C-c C-f function spec C-c f for
C-c C-g generic spec
C-c C-h port spec C-c h header
C-c i if
C-c C-k package spec C-c k package body
C-c l loop
C-c n next
C-c C-p procedure spec C-c p subprogram body
C-c C-r record
C-c C-s subtype C-c s signal
C-c C-t type
C-c v variable
C-c C-w when C-c w while
C-c x exit
C-c ( paired paren C-c - inline comment
C-c I elsif
C-c P process
C-c C compile C-c B bind
C-c E find error list
C-c L name library C-c O options for bind
C-c < and C-c > move backward and forward respectively to the next line
having the same (or lesser) level of indentation.
Variable vhdl-indent controls the number of spaces for indent/undent.
\\{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 'paragraph-ignore-fill-prefix)
(setq paragraph-ignore-fill-prefix t)
; (make-local-variable 'indent-line-function)
; (setq indent-line-function 'c-indent-line)
(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-tabsize (s)
"changes spacing used for indentation. Reads spacing from minibuffer."
(interactive "nnew indentation spacing: ")
(setq vhdl-indent s))
(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-tab ()
"Indent to next tab stop."
(interactive)
(indent-to (* (1+ (/ (current-indentation) vhdl-indent)) vhdl-indent)))
(defun vhdl-untab ()
"Delete backwards to previous tab stop."
(interactive)
(backward-delete-char-untabify vhdl-indent nil))
(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-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-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-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-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-architecture ()
"Insert skeleton architecture body."
(interactive)
(insert "architecture ")
(let ((architecture-name (read-string "architecture name: ")))
(insert architecture-name " of ")
(insert (read-string "entity name: ") " is")
(vhdl-newline)
(vhdl-newline)
(insert "begin")
(vhdl-newline)
(vhdl-newline)
(insert "end " architecture-name ";"))
(end-of-line -2)
(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 "index subtype[s]: "))
(end-of-line)
(insert " of ;")
(backward-char)
(insert (read-string "component-type: "))
(end-of-line))
(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-process ()
"Insert a skeleton process statement, prompting for process name."
(interactive)
(let* ((process-name (read-string "process name: "))
(process-is-named (not (string-equal process-name ""))))
(if process-is-named
(insert process-name ": "))
(insert "process")
(let ((sensitivity-list (read-string "sensitivity list: ")))
(if (not (string-equal sensitivity-list ""))
(insert " (" sensitivity-list ")")))
(vhdl-newline)
(vhdl-newline)
(insert "begin")
(vhdl-newline)
(vhdl-newline)
(insert "end process")
(if process-is-named
(insert " " process-name))
(insert ";"))
(end-of-line 0)
(vhdl-tab)
(end-of-line -1)
(vhdl-tab))
(defun vhdl-block ()
"Insert a block with a declaration part and indent for the 1st declaration."
(interactive)
(let ((block-name (read-string "block name: ")))
(insert block-name ": block")
(let ((guard-exp (read-string "[guard expression]: ")))
(if (not (string-equal guard-exp ""))
(insert " (" guard-exp ")")))
(vhdl-newline)
(vhdl-newline)
(insert "begin")
(vhdl-newline)
(vhdl-newline)
(insert "end block " block-name ";")
)
(end-of-line -2)
(vhdl-tab))
(defun vhdl-else ()
"Add an else clause inside an if-then-end-if clause."
(interactive)
(vhdl-untab)
(insert "else")
(vhdl-newline)
(vhdl-tab))
(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-when ()
"Start a case statement alternative with a when clause."
(interactive)
(vhdl-untab) ; we were indented in code for the last alternative.
(insert "when ")
(insert (read-string "'|'-delimited choice list: ") " =>")
(vhdl-newline)
(vhdl-tab))
(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-header ()
"Insert a comment block containing an RCS header."
(interactive)
(insert "--")
(vhdl-newline)
(insert "-- $RCSfile$")
(vhdl-newline)
(insert "-- $Revision$")
(vhdl-newline)
(insert "-- $Author$")
(vhdl-newline)
(insert "-- $Date$")
(vhdl-newline)
(insert "--")
(vhdl-newline))
(defun vhdl-if ()
"Insert skeleton if statment, 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-elsif ()
"Add an elsif clause to an if statement, prompting for the
boolean-expression."
(interactive)
(vhdl-untab)
(insert "elsif ")
(insert (read-string "condition: ") " then")
(vhdl-newline)
(vhdl-tab))
(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-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-entity-spec ()
"Insert a skeleton entity specification."
(interactive)
(insert "entity ")
(let ((vhdl-entity-name (read-string "entity name: " )))
(insert vhdl-entity-name " is")
(vhdl-newline)
(vhdl-newline)
(insert "begin")
(vhdl-newline)
(vhdl-newline)
(insert "end " vhdl-entity-name ";")
(end-of-line -2)
(vhdl-tab)))
(defun vhdl-component-spec ()
"Insert a skeleton component specification."
(interactive)
(insert "component ")
(insert (read-string "component name: " ))
(vhdl-newline)
(vhdl-newline)
(insert "end component;")
(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-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 -1)
(vhdl-tab)))
(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-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 type: ")))
(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-generic-spec ()
"Insert a generic specification, prompting for arguments."
(interactive)
(insert "generic")
(vhdl-get-arg-list)
(insert ";"))
(defun vhdl-port-spec ()
"Insert a port specification, prompting for arguments."
(interactive)
(insert "port")
(vhdl-get-arg-list)
(insert ";"))
(defun 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-sexp 2)
(let ((p2 (point)))
(forward-sexp -1)
(cons (buffer-substring (point) p2) vhdl-proc-indent)))
(get-vhdl-subprogram-name))
(cons "NAME?" vhdl-proc-indent)))))
(defun vhdl-subprogram-body ()
"Insert frame for subprogram body.
Invoke right after vhdl-function-spec or vhdl-procedure-spec."
(interactive)
(insert " is")
(let ((vhdl-subprogram-name-col (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-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-subtype ()
"Start insertion of a subtype declaration, prompting for the subtype name."
(interactive)
(insert "subtype " (read-string "subtype name: ") " is ;")
(backward-char)
(message "insert subtype indication."))
(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."))
(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))
(defun vhdl-paired-parens ()
"Insert a pair of round parentheses, placing point between them."
(interactive)
(insert "()")
(backward-char))
(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-display-comment ()
"Inserts 3 comment lines, making a display comment."
(interactive)
(insert "--")
(vhdl-newline)
(insert "-- ")
(vhdl-newline)
(insert "--")
(end-of-line 0))
;; Much of this is specific to vhdl-Ed
(defvar vhdl-lib-dir-name "lib" "*Current vhdl program library directory.")
(defvar vhdl-bind-opts "" "*Options to supply for binding.")
(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-options-for-bind ()
"Specify options, such as -m and -i, needed for vhdlbind."
(setq vhdl-bind-opts (read-string "-m and -i options for vhdlbind: ")))
(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
(concat "vhdlcomp " vhdl-init "-l " vhdl-lib-dir-name " "
vhdl-source-file))))
(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"))
(defun vhdl-bind ()
"Bind the current program library, using the current binding options."
(interactive)
(compile (concat "vhdlbind " vhdl-bind-opts " " vhdl-lib-dir-name)))