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)))