vhdl-mode.el for GNUemacs 
Author Message
 vhdl-mode.el for GNUemacs

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

; (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

;
;          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.

;          added port prompt to entity
;


;          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 "\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
      )))
;;----------------------------------------------------



Sun, 25 Jul 1993 23:38:09 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Emacs VHDL editing mode (vhdl-mode.el version 2.74)

2. Emacs VHDL editing mode (vhdl-mode.el version 2.71)

3. Emacs VHDL editing mode (vhdl-mode.el version 2.56.1.1)

4. Emacs VHDL editing mode (vhdl-mode.el version 2.56.1.1)

5. VHDL mode for Emacs (vhdl-mode.el version 2.50)

6. VHDL-mode for GnuEmacs available?

7. GNUEmacs VHDL mode (2 of 2)

8. GNUEmacs VHDL mode (1 of 2)

9. Wanted: VHDL-mode for GNUemacs

10. vhdl-mode.el Homepage...

11. hideshow mode for ruby-mode.el

12. latest ruby-mode.el messing up c++ mode fontification

 

 
Powered by phpBB® Forum Software