GNUEmacs VHDL mode (2 of 2) 
Author Message
 GNUEmacs VHDL mode (2 of 2)

(defun vhdl-stutter-close-bracket () " ']' --> ')', ')]' --> ']'"
   (interactive)
   (if (= (preceding-char) 41) ; close-paren
       (progn (delete-char -1) (insert-char 93 1)) ; close-bracket
     (insert-char 41 1) ; close-paren
     )
   (blink-matching-open)
   )
(defun vhdl-stutter-semicolon () "';;' --> ' : ', ': ;' --> ' := '"
   (interactive)
   (cond ((= (preceding-char) last-input-char)
          (progn (delete-char -1) (insert " : ")))
         ((and (eq last-command 'vhdl-stutter-colon) (= (preceding-char) ? ))
          (progn (delete-char -1) (insert "= ")))
         (t
          (insert-char 59 1))  ; semi-colon
     )
   (setq this-command 'vhdl-stutter-colon)
   )
(defun vhdl-stutter-open-bracket () " '[' --> '(', '([' --> '['"
   (interactive)
   (if (= (preceding-char) 40) ; open-paren
       (progn (delete-char -1) (insert-char 91 1)) ; open-bracket
     (insert-char 40 1) ; open-paren
     )
   )
(defun vhdl-stutter-quote () "'' --> """
   (interactive)
   (if (= (preceding-char) last-input-char)
       (progn (delete-backward-char 1) (insert-char 34 1)) ; double-quote
       (insert-char 39 1)  ; single-quote
       )
   )
(defun vhdl-stutter-comma () " ',,' --> '<='"
   (interactive)
   (cond ((= (preceding-char) last-input-char)
          (progn (delete-char -1) (insert " <= ")))
         (t
          (insert-char 44 1))  ; comma
     )
   )
(defun vhdl-stutter-period () " '..' --> '=>'"
   (interactive)
   (cond ((= (preceding-char) last-input-char)
          (progn (delete-char -1) (insert " => ")))
         (t
          (insert-char 46 1))  ; period
     )
   )
(defun vhdl-paired-parens ()
  "Insert a pair of round parentheses, placing point between them."
  (interactive)
  (insert "()")
  (backward-char)
  )
(defun vhdl-stutter-dash (count)
  "-- starts a comment, --- starts a display comment"
  (interactive "p")
  (cond ((and abbrev-start-location (= abbrev-start-location (point)))
         (setq abbrev-start-location nil)
         (goto-char last-abbrev-location)
         (beginning-of-line nil)
         (vhdl-display-comment))
        ((/= (preceding-char) ?-) ; standard dash (minus)
         (self-insert-command count))
        (t
         (delete-char -1) ; delete the previous dash
         (message "Enter - for display comment, CR for commenting-out code,\
 else 1st char of inline comment")
         (let ((next-input (read-char)))
           (if (= next-input ?-) ; triple dash
               (vhdl-display-comment)
             (setq unread-command-char next-input) ;pushback the char
             (vhdl-inline-comment)
             )
           )
         )
        )
  )
;#############################################################################
;  VHDL CONSTRUCTS
;#############################################################################
(defun vhdl-architecture ()
  "Insert architecture, prompting for name and related entity"
  (interactive)
  (let* ((margin (current-column))
         (name))
    (insert "ARCHITECTURE ")
    (setq name (vhdl-field "architecture name" " OF "))
    (vhdl-field "entity name" " IS")
    (vhdl-begin-end (cons (or name "") margin))
    )
  )
(defun vhdl-array ()
  "Insert array type definition, prompting for component type,
       leaving the user to type in the index subtypes."
  (interactive)
  (insert "ARRAY (")
  (vhdl-field "range[s]" ") OF ")
  (vhdl-field "component type")
  (insert-char 59 1)   ; semi-colon
  )
(defun vhdl-assert ()
  "Inserts a assert skeleton"
  (interactive)
  (insert "ASSERT ")
  (vhdl-field "FALSE evaluating boolean-expression to generate report" "\n")
  (vhdl-indent-line)
  (insert "REPORT ")
  (vhdl-field "string-expression")
  (newline-and-indent)
  (insert "SEVERITY ")
  (vhdl-field "NOTE, WARNING, ERROR, FAILURE" ";")
  )
(defun vhdl-attribute ()
  "Inserts a attribute-declaration skeleton"
  (interactive)
  (insert "ATTRIBUTE ")
  (vhdl-field "attribute name" " : ")
  (vhdl-field "type-mark" ";")
  )
(defun vhdl-block ()
  "Insert a block and indent for the 1st declaration."
  (interactive)
  (let ((name (vhdl-field "block name" ": BLOCK ")))
    ;; handle guard expression, generic and port stuff here
    (vhdl-begin-end (concat "BLOCK " name)) ; end let
    )
  )
(defun vhdl-case ()
  "Build skeleton case statement, prompting for the selector expression.
starts up the first when clause, too."
  (interactive)
  (let ((margin (current-column))
        (name))
    (insert "CASE ")
    (setq name (vhdl-field "selector expression" " IS\n\n"))
    (indent-to margin) (insert "END CASE;")
    ; add a comment at the end so we know which case is closed
    (vhdl-inline-comment) (insert name)
    (forward-line -1)
    (indent-to (+ margin vhdl-indent)) (vhdl-when)
    )
  )
(defun vhdl-component ()
  "Inserts a component skeleton"
  (interactive)
  (let ((margin (current-column)))
    (insert "COMPONENT ")
    (vhdl-field "component-name" "\n")
    (vhdl-indent-line)
    (insert "-- generic ();")
    (newline-and-indent)
    (insert "PORT (")
    (vhdl-field "<name> : <mode> <type>" ");\n")
    (indent-to margin))
  (insert "END COMPONENT;")
  )
(defun vhdl-component-instance ()
  "Inserts a component-instance skeleton"
  (interactive)
  (vhdl-field "instance name" " : ")
  (vhdl-field "component-type" "\n")
  (vhdl-indent-line)
  (insert "-- generic map ()")
  (newline-and-indent)
  (insert "PORT MAP (")
  (vhdl-field "association-list" ");\n")
  )
(defun vhdl-configuration-spec ()
  "Inserts a configuration-spec skeleton"
  (interactive)
  (insert "FOR ")
  (vhdl-field "list of components" ": ")
  (vhdl-field "component type" "\n")
  (vhdl-indent-line)
  (insert "USE ENTITY ")
  (vhdl-field "lib.entity(arch)" "\n")
  (vhdl-indent-line)
  (insert "-- generic map ()")
  (newline-and-indent)
  (insert "-- port map ()")
  (newline-and-indent)
  (insert ";\n")
  (vhdl-indent-line)
  )
(defun vhdl-configuration-declaration ()
  "Inserts a configuration-declaration skeleton"
  (interactive)
  (let ((margin (current-column))
        (dummy (insert "CONFIGURATION "))
        (name (vhdl-field "name" " OF ")))
    (vhdl-field "item to be configured" " IS\n\n")
    (indent-to margin) (insert "END " name ";"))
  (end-of-line 0)
  (vhdl-indent-line)
  )
(defun vhdl-constant ()
  "Start insertion of CONSTANT declaration, prompting for the constant name."
  (interactive)
  (insert "CONSTANT ")
  (vhdl-field "constant name")
  (insert " : ")
  (vhdl-field "constant type " " := ")
  (vhdl-field "value " ";")
  (newline-and-indent)
  )
(defun vhdl-else ()
  "Add an else clause inside an if-then-end-if clause."
  (interactive)
  (vhdl-untab)
  (insert "ELSE\n")
  (vhdl-indent-line)
  )
(defun vhdl-elsif ()
  "Add elsif clause to IF statement, prompting for the boolean-expression."
  (interactive)
  (vhdl-untab)
  (insert "ELSIF (")
  (vhdl-field "condition" ") THEN\n")
  (vhdl-indent-line)
  )
(defun vhdl-entity ()
  "Insert entity, prompting for name"
  (interactive)
  (let (name)
    (insert "ENTITY ")
    (setq name (vhdl-field "entity name" " IS\n\n"))
    (insert "END " name ";"))
  (forward-line -1)
  (vhdl-indent-line)
  )
(defun vhdl-exit ()
  "Insert an exit statement, prompting for loop name and condition."
  (interactive)
  (insert "EXIT ")
  (if (string-equal (vhdl-field "name of loop to exit" " ") "")
      (delete-char -1))
  (let ((opoint (point))
        (exit (vhdl-field "exit condition" ";")))
    (cond ((string-equal exit "")
           (delete-char -1))
          ((string-match "^ *[Ww][Hh][Ee][Nn] +" exit)
           ())
          (t
           (goto-char opoint) (insert "WHEN ") (end-of-line nil))
          )
    )
  )
(defun vhdl-for-loop ()
  "Build a skeleton for-loop statement, prompting for the loop parameters."
  (interactive)
  (let* ((margin (current-column))
         (name (vhdl-field "loop name"))
         (named (not (string-equal name "")))
         (index))
    (if named (insert " : "))
    (insert "FOR ")
    (setq index (vhdl-field "loop variable" " IN "))
    (vhdl-field "range" " LOOP\n\n")
    (indent-to margin)
    (insert "END LOOP" (if named (concat " " name ";")?;))
    (if (not named) (progn (vhdl-inline-comment) (insert index)))
    (forward-line -1)
    (vhdl-indent-line)
    )
  )
(defun vhdl-function-spec ()
  "Insert a function specification.  Prompts for name and arguments."
  (interactive)
  (let* ((margin (current-column)))
    (insert "FUNCTION ")
    (vhdl-field "function name")
    (vhdl-get-arg-list)
    (insert " RETURN ")
    (vhdl-field "result typemark" ";\n")
    (indent-to margin))
  )
(defun vhdl-function-body ()
  "Insert frame for function body."
  (interactive)
  (insert "FUNCTION ")
  (vhdl-field "function name")
  (vhdl-get-arg-list)
  (insert " RETURN ")
  (vhdl-field "result typemark")
  (insert " IS")
  (vhdl-begin-end (vhdl-get-subprogram-name))
  (vhdl-indent-line)
  )
(defun vhdl-generate ()
  "Inserts a generate skeleton - ****** set up if or for scheme"
  (interactive)
  (let ((margin (current-column))
        (label (vhdl-field "label" ": ")))
    (vhdl-field "generate-scheme (FOR | IF)" " GENERATE\n\n")
    (indent-to margin) (insert "END GENERATE " label ";"))
  (end-of-line 0)
  (vhdl-indent-line)
  )
(defun vhdl-header ()
  "Insert a comment block containing the module title, author, etc."
  (interactive)
  (let ((start (point)))
  (insert
"
-------------------------------------------------------------------------------
--                                     copyright 1992
--                                     Honeywell Systems & Research Center
--                                     All Rights Reserved
--
--   File name :  " (buffer-name) "
--   Title     :  []
--   Module    :  []
--
--   Purpose   :  []
--
--   Roadmap   :
-------------------------------------------------------------------------------
--   Modification History :
--          Date    \t\tAuthor  \tRevision \tComments
-- " (current-time-string) "\t" (user-full-name) "\tRev A \t\tCreation
-------------------------------------------------------------------------------
-- ToDo: []
--
-------------------------------------------------------------------------------
--                 EXTERNAL SIGNAL DESCRIPTIONS                              --
-------------------------------------------------------------------------------
--
--
-------------------------------------------------------------------------------

USE work.five_state.ALL;                 -- basic types package

-------------------------------------------------------------------------------
ARCHITECTURE RTL OF [Name] IS
  -----------------------------------------------------------------------------
  --  INTERNAL CONSTANT, ENUMERATED TYPES, AND GENERIC DEFINITIONS           --
  -----------------------------------------------------------------------------

  -----------------------------------------------------------------------------
  --                    INTERNAL SIGNAL DEFINITIONS                          --
  -----------------------------------------------------------------------------

-------------------------------------------------------------------------------
BEGIN -- Architecture RTL of [Name]

  -----------------------------------------------------------------------------
  --                    CONCURRENT SIGNAL ASSIGNMENTS                        --
  -----------------------------------------------------------------------------

  -----------------------------------------------------------------------------
  --                         CONCURRENT PROCESSES                            --
  -----------------------------------------------------------------------------

  -----------------------------------------------------------------------------
  --  Process:
  --  Purpose:
  --          
  --
  --  Inputs:  Ck, ResetN,
  --          
  --  Outputs:
  -----------------------------------------------------------------------------
  [ProcessName]: PROCESS (Ck, ResetN)
    ---------------------------------------------------------------------------
    --                      PROCESS VARIABLES                                --
    ---------------------------------------------------------------------------

    ---------------------------------------------------------------------------
    --                   INTERNAL FUNCTION DEFINITIONS                       --
    ---------------------------------------------------------------------------

    ---------------------------------------------------------------------------
    --                   INTERNAL PROCEDURE DEFINITIONS                      --
    ---------------------------------------------------------------------------

  BEGIN                                  --  process Proc

    -- this creates an asynchronous reset on all the FFs controlled by this
    -- process.
    IF (ResetN = LOGIC0) THEN

    -- this guards the whole process for a rising clock edge.  That results
    -- in all the signals being set in here turning into registers.
    ELSIF Ck'EVENT AND Ck = '1' THEN

      -------------------------------------------------------------------------
      --                    PROCESS FUNCTIONALITY                            --
      -------------------------------------------------------------------------

    END IF;                              --  Ck

  END PROCESS [ProcessName];
  -----------------------------------------------------------------------------

END RTL;                                 --  [Name]
-------------------------------------------------------------------------------
")
    (goto-char start)
    (search-forward "[]") (replace-match (read-string "Title: ") t t)
    (search-forward "[]") (replace-match (read-string "Purpose: ") t t)
    (search-forward "[]") (replace-match (read-string "Number of processes: "))
    (let (tail (processes (- (preceding-char) 48)))
      (search-forward "[]") (replace-match (read-string "Process Name: ") t t)
      (search-forward "[Description]")
      (message "Enter description followed by linefeed.") (sit-for 0)
      (delete-char -13)
      (setq tail (save-excursion (forward-line 1) (copy-marker (point))))
      (recursive-edit)
      (while (> (setq processes (1- processes)) 0)
        (goto-char tail)
        (open-line 1)
        (insert "--                " (read-string "Process Name: ") ":\n")
        (insert "--                  ")
        (message "Enter description followed by linefeed.") (sit-for 0)
        (recursive-edit)
      )
    )
    (search-forward "[]") (delete-char -2)
    ;more stuff here to go back and edit [] fields
  )
)
(defun vhdl-if ()
  "Insert skeleton if statement, prompting for a boolean-expression."
  (interactive)
  (let ((margin (current-column)))
    (insert "IF (")
    (vhdl-field "condition" ") THEN\n\n")
    (indent-to margin) (insert "END IF;")
    (forward-line -1)
    (vhdl-indent-line)
    )
  )
(defun vhdl-loop ()
  "insert a skeleton loop statement.  exit statement added by hand."
  (interactive)
  (let* ((margin (current-column))
         (name (vhdl-field "loop name"))
         (named (not (string-equal name ""))))
    (if named (insert " : "))
    (insert "LOOP \n\n")
    (indent-to margin)
    (insert "END LOOP" (if named (concat " " name ";") ?;))
    (forward-line -1)
    (vhdl-indent-line)
    )
  )
(defun vhdl-package-spec ()
  "Insert a skeleton package specification."
  (interactive)
  (let ((margin (current-column))
        (dummy  (insert "PACKAGE "))
        (name (vhdl-field "package name" " IS\n\n")))
    (indent-to margin) (insert "END " name ";")
    (forward-line -1)
    )
  )
(defun vhdl-package-body ()
  "Insert a skeleton package body --  includes a begin statement."
  (interactive)
  (let ((margin (current-column))
        (dummy (insert "PACKAGE BODY "))
        (name (vhdl-field "package name" " IS\n\n")))
    (indent-to margin) (insert "END " name ";")
    (forward-line -1)
    (vhdl-indent-line)
    )
  )
(defun vhdl-procedure-spec ()
  "Insert a procedure specification, prompting for its name and arguments."
  (interactive)
  (let ((margin (current-column)))
    (insert "PROCEDURE ")
    (vhdl-field "procedure name")
    (vhdl-get-arg-list)
    (insert ";\n")
    (indent-to margin))
  )
(defun vhdl-procedure-body ()
  "Insert frame for procedure body."
  (interactive)
  (insert "PROCEDURE ")
  (vhdl-field "procedure name")
  (vhdl-get-arg-list)
  (insert " IS")
  (vhdl-begin-end (vhdl-get-subprogram-name))
  )
(defun vhdl-process ()
  "Inserts a process skeleton"
  (interactive)
  (let* ((margin (current-column))
         (line (current-line))
         (finalline)
         (name (vhdl-field "process name"))
         (named (not (string-equal name ""))))
    (if named (insert " : "))
    (insert "PROCESS")
    (vhdl-get-arg-list)
    (vhdl-begin-end (cons (concat "PROCESS " (or name "") ) margin))
    (setq finalline (current-line))
    (forward-line (- line finalline))
    (open-line 1)
    (indent-to margin)
    (vhdl-display-comment)
    (insert "Process:  ") (if named (insert (concat name " "))) (vhdl-return)
    (insert "Purpose:  ") (vhdl-return)
    (insert "Inputs:   ") (vhdl-return)
    (insert "Outputs:  ")
    ; "6" for all the above comment lines
    (forward-line (- (+ finalline 6) (current-line)))
    (indent-to (+ margin vhdl-indent))
  )
)
(defun vhdl-record ()
  "Insert a skeleton record type declaration."
  (interactive)
  (let ((margin (current-column)))
    (insert "RECORD\n")
    (newline)
    (indent-to margin)
    (insert "END RECORD;")
    (end-of-line 0)
    (vhdl-indent-line))
  )
(defun vhdl-return-value ()
  "Insert a VHDL return statement, prompting for return value."
  (interactive)
  (let ((margin (current-column)))
    (insert "RETURN (")
    (vhdl-field "return expression" ");\n")
    (indent-to margin))
  )
(defun vhdl-selected-signal-assignment ()
  "Inserts a selected signal assignment.  Does first vhdl-selected-when"
  (interactive)
  (insert "WITH ")
  (vhdl-field "selector expression" " SELECT\n")
  (vhdl-indent-line)
  (vhdl-field "target signal" " <= ")
  (vhdl-field "options (guarded | transport)" "\n")
  (vhdl-indent-line)
  (vhdl-selected-when)
  (newline-and-indent)
  (insert-char 59 1) ;semi-colon
  (end-of-line 0)
  )
(defun vhdl-selected-when ()
  "Inserts a when section into a selected signal assignment."
  (interactive)
  (vhdl-field "waveform1" " WHEN ")
  (vhdl-field "choices1 " ",")
  (newline-and-indent)
  )
(defun vhdl-signal ()
  "Start insertion of a signal declaration, prompting for the signal name."
  (interactive)
  (insert "SIGNAL ")
  (vhdl-field "signal name")
  (insert " : ")
  (vhdl-field "signal type [ := initialization ]" ";")
  (newline-and-indent)
  )
(defun vhdl-subtype ()  
  "Start insertion of a subtype declaration, prompting for the subtype name."
  (interactive)
  (insert "SUBTYPE ")
  (vhdl-field "subtype name:" " IS ")
  (vhdl-field "insert subtype indication, and resolution function" ";")
  )
(defun vhdl-type ()
  "Start insertion of a type declaration, prompting for the type name."
  (interactive)
  (insert "TYPE ")
  (vhdl-field "type name")
  (insert " IS ")
  (vhdl-field "type definition" ";")
  (backward-char 1)
  )
(defun vhdl-use ()
  "Inserts a use clause, prompting for the list of packages used."
  (interactive)
  (insert "USE ")
  (vhdl-field "list of packages to use" ";")
)
(defun vhdl-variable ()
  "Start insertion of a variable declaration, prompting for variable name."
  (interactive)
  (insert "VARIABLE ")
  (vhdl-field "variable name")
  (insert " : ")
  (vhdl-field "variable type [ := initialization ]" ";")
  (newline-and-indent)
  )
(defun vhdl-wait ()
  "Inserts a wait skeleton"
  (interactive)
  (insert "WAIT ")
  (vhdl-field "<on sensitivity-list | until boolean-expression\
   | for time expression>*" ";")
  )
(defun vhdl-when ()
  " Simply capitalize WHEN.  Support for WHEN within CASE and SELECT
and EXIT has been removed due to complexity (and limited value)"
  (interactive)
  (insert "WHEN ")
  ;
  ;  "Start a case statement alternative with a when clause."
  ;  (interactive)
  ;  (if (save-excursion
  ;     (forward-line -1)
  ;     (while (looking-at "^[ \t]*$") (forward-line -1))
  ;     (not (looking-at "^[ \t]*CASE ")))
  ;      (backward-delete-char-untabify vhdl-indent nil)
  ;    )
  ;  (insert "WHEN ")
  ;  (vhdl-field "'|'-delimited choice list" " =>")
  ;  (newline-and-indent)
  )
(defun vhdl-while-loop ()
  (interactive)
  (let* ((margin (current-column))
         (name (vhdl-field "loop name"))
         (named (not (string-equal name ""))))
    (if named (insert " : "))
    (insert "WHILE ")
    (vhdl-field "entry condition" " LOOP\n\n")
    (indent-to margin)
    (insert "END LOOP" (if named (concat " " name ";") ?;))
    (forward-line -1)
    (vhdl-indent-line)
    )
  )
(defun vhdl-conditional-signal-assignment ()
  "Inserts a conditional-signal-assignment skeleton"
  (interactive)
  (vhdl-field "target" " <= ")
  (vhdl-field "options (guarded | transport)" "\n")
  (vhdl-indent-line)
  (vhdl-conditional-waveform)
  (insert 59 1) ;semi-colon
  (backward-char)
  )
(defun vhdl-conditional-waveform ()
  "Inserts a conditional-signal-assignment waveform."
  (interactive)
  (vhdl-field "<expr[after time]>+ when boolean-expr [else]")
  (newline-and-indent)
  )
;#############################################################################
;  LOGIC FUNCTIONS
;#############################################################################
(defun vhdl-and ()
  " Simply capitalize AND."
  (interactive)
  (insert "AND ")
  )
(defun vhdl-or ()
  " Simply capitalize OR."
  (interactive)
  (insert "OR ")
  )
(defun vhdl-nand ()
  " Simply capitalize NAND."
  (interactive)
  (insert "NAND ")
  )
(defun vhdl-nor ()
  " Simply capitalize NOR."
  (interactive)
  (insert "NOR ")
  )
(defun vhdl-xor ()
  " Simply capitalize XOR."
  (interactive)
  (insert "XOR ")
  )
(defun vhdl-xnor ()
  " Simply capitalize XNOR."
  (interactive)
  (insert "XNOR ")
  )
(defun vhdl-not ()
  " Simply capitalize NOT."
  (interactive)
  (insert "NOT ")
  )

;#############################################################################
; IDIOMS
;#############################################################################
(defun vhdl-clocked-wait ()
  "Inserts a VHDL rising edge clocked WAIT statement"
  (interactive)
  (insert "WAIT UNTIL ")
  (let* ((clock  (vhdl-field "Clock Name")))
    (insert "'EVENT AND ")
    (insert clock)
    (insert " = '1';")
    (vhdl-return)
  )
)

(defun vhdl-clock-async-reset ()
  "Inserts a VHDL rising edge clock and asynchronous reset"
  (interactive)
  (let* ( (margin (current-column)))
    (vhdl-inline-comment) (insert "Asynchronous (active low) reset")
    (vhdl-return)
    (insert "IF ( ")
    (vhdl-field "Active Low Reset Line")
    (insert " = LOGIC0 ) THEN\n\n")
    (indent-to margin)
    (vhdl-inline-comment)
    (insert "This guards the whole process for a rising clock edge. ")
    (vhdl-return)
    (insert "That causes all the signals set in here to be registers.\n")
    (indent-to margin)
    (insert "ELSIF ( ")
    (let* ((clock  (vhdl-field "Clock Name")))
      (insert "'EVENT AND ")
      (insert clock)
      (insert " = LOGIC1 ) THEN\n")
      (indent-to margin)
      (insert "END IF;")
      (vhdl-inline-comment)(insert clock))
    (forward-line -1)
    (end-of-line nil)
    (vhdl-return)
    )
)

;#############################################################################
;  COMMENT FUNCTIONS
;#############################################################################
(defun vhdl-comment-indent ()
  (let* ((opoint (point))
        (col (progn
               (forward-line -1)
               (if (re-search-forward "--" opoint t)
                   (- (current-column) 2) ;Existing comment at bol stays there.
                 (goto-char opoint)
                 (skip-chars-backward " \t")
                 (max comment-column  ;Else indent to comment column
                      (1+ (current-column))) ;except leave at least one space.
                 )
               )
             )
        )
    (goto-char opoint)
    col
    )
)
(defun vhdl-inline-comment ()
  "Start a comment at the end of the line.
  If on line with code, indent at least comment-column.
  If starting after end-comment-column, start a new line."
  (interactive)
  (if (> (current-column) end-comment-column) (newline-and-indent))
  (if (looking-at "[ \t]*$") ;end of line
      (let ((margin (current-column)))
        (delete-horizontal-space)
        (if (bolp)
            (progn (indent-to margin) (insert "--  "))
          (indent-to comment-column)
          (insert "--  ")
          ))
      ; else code following current point implies commenting out code
    (if (= unread-command-char -1)
        (message "Enter CR if commenting out a line of code."))
    (let (next-input code)
      (while (= (setq next-input (read-char)) 13) ; CR
        (insert "--"); or have a space after it?
        (forward-char -2)
        (next-line 1)
        (message "Enter CR if commenting out a line of code.")
        (setq code t)
        )
      (if (not code) (progn
          (indent-to comment-column)
          (insert "--  ") ;hardwire to 2 spaces or use vhdl-indent?
          ))
      (setq unread-command-char next-input) ;pushback the char
      )
    )
  )
(defun vhdl-display-comment ()
  "Inserts 3 comment lines at the current indent, making a display comment."
  (interactive)
  (cond ((and (bolp) (not (eolp)))
         (insert-char ?\n 1) (forward-char -1))
        ((save-excursion
           (beginning-of-line nil) (not (looking-at "[ \t]*$")))
         (progn (end-of-line) (newline-and-indent)))
        )
  (let* ((col (current-column))
         (len (- end-comment-column col)))
    (insert-char ?- len)
    (insert-char ?\n 2)
    (insert-char ?  col)
    (insert-char ?- len)
    (end-of-line 0)
    (insert-char ?  col)
    )
  (insert "--  ") ;hardwire to 2 spaces or use vhdl-indent?
  )
;#############################################################################
;  HOOKED ABBREV FUNCTIONS
;#############################################################################
(defun vhdl-hooked-abbrev (fun)
  "Do FUNCTION, if syntax says abbrev is a keyword, invoked by hooked abbrev,
   but not if inside a comment or quote)"
  (if (or (vhdl-in-comment)
          (vhdl-in-quote)
          (save-excursion (forward-word -1) (looking-at "END")))
      (progn (undo-start) ;unexpand-abbrev has capitalization problem on null
             (undo-more 1)
             (forward-word 1))
    (let ((invoke-char last-command-char) (abbrev-mode -1))
      (funcall fun)
      (if (= invoke-char ?-) (setq abbrev-start-location (point)))
      (if (or (eq (key-binding "\^?") 'backward-delete-char-untabify)
              (eq (key-binding "\^?") 'backward-delete-char))
          (setq unread-command-char ?\^?) ; push back a delete char
        (if (= (preceding-char) invoke-char) (delete-char -1)))
      ) ; ^ UGLY, but that's what you get when you want it both ways
    )
  )
(defun vhdl-architecture-hook () "hooked version of vhdl-architecture."
  (vhdl-hooked-abbrev 'vhdl-architecture))
(defun vhdl-array-hook () "hooked version of vhdl-array."
  (vhdl-hooked-abbrev 'vhdl-array))
(defun vhdl-assert-hook () "hooked version of vhdl-assert."
  (vhdl-hooked-abbrev 'vhdl-assert))
(defun vhdl-attribute-hook () "hooked version of vhdl-attribute."
  (vhdl-hooked-abbrev 'vhdl-attribute))
(defun vhdl-block-hook () "hooked version of vhdl-block."
  (vhdl-hooked-abbrev 'vhdl-block))
(defun vhdl-case-hook () "hooked version of vhdl-case."
  (vhdl-hooked-abbrev 'vhdl-case))
(defun vhdl-component-hook () "hooked version of vhdl-component."
  (vhdl-hooked-abbrev 'vhdl-component))
(defun vhdl-component-instance-hook ()
  "hooked version of vhdl-component-instance."
  (vhdl-hooked-abbrev 'vhdl-component-instance))
(defun vhdl-configuration-declaration-hook ()
  "hooked version of vhdl-configuration-declaration."
  (vhdl-hooked-abbrev 'vhdl-configuration-declaration))
(defun vhdl-configuration-spec-hook ()
  "hooked version of vhdl-configuration-spec."
  (vhdl-hooked-abbrev 'vhdl-configuration-spec))
(defun vhdl-constant-hook () "hooked version of vhdl-constant."
  (vhdl-hooked-abbrev 'vhdl-constant))
(defun vhdl-display-comment-hook () "hooked version of vhdl-display-comment."
  (vhdl-hooked-abbrev 'vhdl-display-comment))
(defun vhdl-else-hook () "hooked version of vhdl-else."
  (vhdl-hooked-abbrev 'vhdl-else))
(defun vhdl-elsif-hook () "hooked version of vhdl-elsif."
  (vhdl-hooked-abbrev 'vhdl-elsif))
(defun vhdl-entity-hook () "hooked version of vhdl-entity."
  (vhdl-hooked-abbrev 'vhdl-entity))
(defun vhdl-exit-hook () "hooked version of vhdl-exit."
  (vhdl-hooked-abbrev 'vhdl-exit))
(defun vhdl-for-loop-hook () "hooked version of vhdl-for-loop."
  (vhdl-hooked-abbrev 'vhdl-for-loop))
(defun vhdl-function-body-hook () "hooked version of vhdl-function-body."
  (vhdl-hooked-abbrev 'vhdl-function-body))
(defun vhdl-function-spec-hook () "hooked version of vhdl-function-spec."
  (vhdl-hooked-abbrev 'vhdl-function-spec))
(defun vhdl-generate-hook () "hooked version of vhdl-generate."
  (vhdl-hooked-abbrev 'vhdl-generate))
(defun vhdl-header-hook () "hooked version of vhdl-header."
  (vhdl-hooked-abbrev 'vhdl-header))
(defun vhdl-if-hook () "hooked version of vhdl-if."
  (vhdl-hooked-abbrev 'vhdl-if))
(defun vhdl-loop-hook () "hooked version of vhdl-loop."
  (vhdl-hooked-abbrev 'vhdl-loop))
(defun vhdl-package-body-hook () "hooked version of vhdl-package-body."
  (vhdl-hooked-abbrev 'vhdl-package-body))
(defun vhdl-package-spec-hook () "hooked version of vhdl-package-spec."
  (vhdl-hooked-abbrev 'vhdl-package-spec))
(defun vhdl-procedure-body-hook () "hooked version of vhdl-procedure-body."
  (vhdl-hooked-abbrev 'vhdl-procedure-body))
(defun vhdl-procedure-spec-hook () "hooked version of vhdl-procedure-spec."
  (vhdl-hooked-abbrev 'vhdl-procedure-spec))
(defun vhdl-process-hook () "hooked version of vhdl-process."
  (vhdl-hooked-abbrev 'vhdl-process))
(defun vhdl-record-hook () "hooked version of vhdl-record."
  (vhdl-hooked-abbrev 'vhdl-record))
(defun vhdl-return-hook () "hooked version of vhdl-return-value."
  (vhdl-hooked-abbrev 'vhdl-return-value))
(defun vhdl-selected-signal-assignment-hook ()
  "hooked version of vhdl-selected-signal-assignment."
  (vhdl-hooked-abbrev 'vhdl-selected-signal-assignment))
(defun vhdl-selected-when-hook () "hooked version of vhdl-selected-when."
  (vhdl-hooked-abbrev 'vhdl-selected-when))
(defun vhdl-signal-hook () "hooked version of vhdl-signal."
  (vhdl-hooked-abbrev 'vhdl-signal))
(defun vhdl-subtype-hook () "hooked version of vhdl-subtype."
  (vhdl-hooked-abbrev 'vhdl-subtype))
(defun vhdl-type-hook () "hooked version of vhdl-type."
  (vhdl-hooked-abbrev 'vhdl-type))
(defun vhdl-use-hook () "hooked version of vhdl-use."
  (vhdl-hooked-abbrev 'vhdl-use))
(defun vhdl-variable-hook () "hooked version of vhdl-variable."
  (vhdl-hooked-abbrev 'vhdl-variable))
(defun vhdl-wait-hook () "hooked version of vhdl-wait."
  (vhdl-hooked-abbrev 'vhdl-wait))
(defun vhdl-when-hook () "hooked version of vhdl-when."
  (vhdl-hooked-abbrev 'vhdl-when))
(defun vhdl-while-loop-hook () "hooked version of vhdl-while-loop."
  (vhdl-hooked-abbrev 'vhdl-while-loop))

(defun vhdl-and-hook () "hooked version of vhdl-and."
  (vhdl-hooked-abbrev 'vhdl-and))
(defun vhdl-or-hook () "hooked version of vhdl-or."
  (vhdl-hooked-abbrev 'vhdl-or))
(defun vhdl-nand-hook () "hooked version of vhdl-nand."
  (vhdl-hooked-abbrev 'vhdl-nand))
(defun vhdl-nor-hook () "hooked version of vhdl-nor."
  (vhdl-hooked-abbrev 'vhdl-nor))
(defun vhdl-xor-hook () "hooked version of vhdl-xor."
  (vhdl-hooked-abbrev 'vhdl-xor))
(defun vhdl-xnor-hook () "hooked version of vhdl-xnor."
  (vhdl-hooked-abbrev 'vhdl-xnor))
(defun vhdl-not-hook () "hooked version of vhdl-not."
  (vhdl-hooked-abbrev 'vhdl-not))

(run-hooks 'vhdl-load-hook)
;#############################################################################
; END OF VHDL.EL
;#############################################################################
;
;#!/bin/csh -f
;# vgrind a vhdl file,  Usage: vhdlgrind [vgrind args] [filename]
;# This is a polyglot file, read by both csh and vgrind
;# The environment variable $TROFF should be set to your favorite *roff,
;# e.g. /usr/ucb/ptroff for postscript and set $PRINTER to your local printer
;if (! $?TROFF) setenv TROFF /usr/ucb/ptroff

;if ($#argv == 0) then
;  head -5 $n; exit
;endif
;(if ($argv[$#argv] =~ */*) cd $argv[$#argv]:h;\
; /usr/ucb/vgrind -lvhdl -d $n $argv[$num] $argv[$#argv]:t &)
;exit
;
;vhdl|vhd:\
;       :pb=(^\d?(procedure|function)\d\p\d|\(|;|\:):\
;       :bb=\d(begin|block|body|case|component|configuration\
;       |entity|for|if|loop|package|process|while|with)\d:\
;       :be=\dend:\
;       :cb=--:ce=$:\
;       :oc:\
;       :kw=abs access after alias all and architecture array assert attribute\
;       begin block body buffer bus\
;       case component configuration constant\
;       disconnect downto\
;       else elsif end entity exit\
;       file for function\
;       generate generic guarded\
;       if in inout is\
;       label library linkage loop\
;       map mod\
;       nand new next nor not null\
;       of on open or others out\
;       package port procedure process\
;       range record register rem report return reverse_range\
;       select severity signal subtype\
;       then to transport type\
;       units until use\
;       variable\
;       wait when while with\
;       xor:
;

;
; end of vhdl.el part 2 of 2
;



Sun, 24 Jul 1994 00:18:07 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. GNUEmacs VHDL mode (1 of 2)

2. VHDL-mode for GnuEmacs available?

3. vhdl-mode.el for GNUemacs

4. Wanted: VHDL-mode for GNUemacs

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

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

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

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

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

10. TAGS for VHDL/GNUEmacs

11. Xemacs VHDL mode (vhdl.zip file, 83 Kbytes) - vhdl.zip (1/1)

12. Free VHDL Editor: Emacs VHDL Mode 3.28

 

 
Powered by phpBB® Forum Software