Make your own free website on Tripod.com
Vhdl    Mode    Additions

This contains only the additional functions written by me as an addition to 
the vhdl-mode.el original file.
;;; Some modifications were made to the original file by Rajkumar Kadam
;;; Email : rkadam@usa.net
;;; Auto loading of header for a new vhdl file, multiple component instantiation 
;;; were the features added.
;;; The features are not thoroughly checked.
;;; Improper use of the features may crib 
;;********************************************************************************
;;*******************************************************************************


;;;; Component instantiation checked in this version

;;; vhdl-mode.el --- major mode for editing VHDL code

;; Copyright (C) 1997 Reto Zimmermann

;; Author:        Reto Zimmermann 
;; Maintainer:    Reto Zimmermann 
;; Created:       1997/08/06
;; Version:       3.10
;; Last Modified: 1997/10/03
;; Keywords:      languages VHDL
;; Archive:       http://www.iis.ee.ethz.ch/~zimmi/vhdl-mode.html

;; ############################################################################
;; Sourcevs
;; ############################################################################

;; This file was assembled from the following sources with major modifications:

;; Syntax analysis and indentation: (no modifications)
;;   `vhdl-mode.el' by Rod Whitby, version 2.73
;;   Copyright (C) 1994, 1995 Rodney J. Whitby 
;;   Copyright (C) 1992, 1993, 1994 Barry A. Warsaw
;;   Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
;;   Archive: http://www.geocities.com/SiliconValley/Park/8287/

;; Electrification: (with major modification)
;;   `vhdl.el' by Bob Pack
;;   Copyright (C) 1992 Bob Pack 
;;   Copyright (C) 1985, 1987, 1988 Richard M. Stallman
;;   Copyright (C) 1988 Steve Grout
;;   Archive: ftp://jupiter.ee.pitt.edu/pub/vhdl-info/

;; Fontification: (with major modifications)
;;   `vhdl-highlight.el' by Ken Wood, version 2.62
;;   Copyright (C) 1995 Ken Wood 
;;   Archive: ftp://ftp.eda.com.au/pub/emacs

;; Source file menu: (with slight modifications)
;;   `vhdl-mode.el' by Michael Laajanen, version 1.15
;;   Copyright (C) 1997 Michael Laajanen 

;; ############################################################################
;; Modification history
;; ############################################################################

;; 1997/09/01 1.2 : usage of `unread-command-events' adapted for compatibility
;;		    with XEmacs
;; 1997/09/01 1.2 : menu definition changed for compatibility with XEmacs
;; 1997/09/02 1.3 : changed colors for XEmacs
;; 1997/09/02 1.3 : corrected case of keywords in some template generators
;; 1997/09/03 1.4 : added new color for template prompts
;; 1997/09/03 1.4 : inserted more empty lines in block and entity templates
;; 1997/09/04 1.5 : added prompt for library name in configuration spec.
;; 1997/09/05 1.6 : fixed bug cursor position after typing keyword before text
;; 1997/09/05 1.6 : added `column-number-mode'
;; 1997/09/05 1.6 : added `indent-tabs-mode' to .emacs initialization
;; 1997/09/05 1.6 : added command and variable for disabling of stuttering
;; 1997/09/05 1.6 : `vhdl-comments' replaced by `vhdl-comment-level' which
;;                  provides three different levels of commenting
;; 1997/09/08 1.7 : `vhdl-default-indent' added for `begin' and `end'
;; 1997/09/08 1.7 : `dabbrev-case-fold-search' set to nil
;; 1997/09/10 1.7 : menu re-ordered
;; 1997/09/10 1.7 : index menu inserted
;; 1997/09/11 1.7 : changed `vhdl-others'
;; 1997/09/11 1.7 : additional color for predefined attributes and enum. values
;; 1997/09/11 1.7 : added `vhdl-concurrent-signal-assignment'
;; 1997/09/11 1.7 : deleted prompt for `options' in signal assignments
;; 1997/09/17 1.7 : fixed printing under XEmacs
;; 1997/09/17 1.8 : replaced `vhdl-for-loop' by `vhdl-for'
;; 1997/09/22 1.8 : added source file menu
;; 1997/09/24 1.9 : adaptions for GNU Emacs 20
;; 1997/09/24 1.9 : adaptions in `vhdl-for' and `vhdl-configuration-decl'
;; 1997/09/24 1.9 : added signal coloring for GNU Emacs 20 and XEmacs
;; 1997/09/24 1.9 : removed print functions, used `ps-print.el' instead
;; 1997/09/25 1.9 : major changes of fontification definitions
;; 1997/09/30 1.10 : source file compilation added
;; 1997/10/03 1.10 : source file compilation : `make' command added
;; 1997/10/03 1.10 : changed `case-fold-search' to nil in minibuffer
;; 1997/10/21 3.10 : changed version number 1.XX to 3.XX

;; ############################################################################

;; This file is not part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;; ############################################################################
;; Description
;; ############################################################################

;; This package for VHDL code features:

;;   - Highlighting of keywords, comments, built-in types, and strings
;;   - Indentation based on versatile syntax analysis (by Rod Whitby)
;;   - Electrification (automatic template generation) for most VHDL constructs
;;   - Word completion (dynamic abbreviations)
;;   - Menu containing all VHDL mode commands
;;   - Index menu (jump index to main units and blocks in a file)
;;   - Source file menu (menu of all source files in current directory)
;;   - Source file compilation (syntax analysis)
;;   - Postscript printing with fontification
;;   - Lower and upper case keywords
;;   - Easy customization
;;   - Works under GNU Emacs and XEmacs

;; ############################################################################
;; Emacs Versions
;; ############################################################################

;; - GNU Emacs 19.34 (intensively tested, all features supported)
;; - GNU Emacs 20.2 (marginally tested, all features supported)
;; - XEmacs 19.15 (marginally tested, most features supported)

;; ############################################################################
;; Installation
;; ############################################################################

;; - Install the files at your Emacs installation site
;;   or put it in an arbitrary directory and add the following line to
;;   your Emacs startup file (`.emacs'). `vhdl-mode.elc' is compiled for
;;   GNU Emacs. For XEmacs, re-compile it using the command
;;   `xemacs -batch -q -no-site-file -f batch-byte-compile vhdl-mode.el'.

;; (setq load-path (cons (expand-file-name "") load-path))

;; - Add the following lines to your Emacs startup file (`.emacs')
;;   Adapt the variable settings to your needs.

;; ;;;
;; ;;; VHDL mode
;; ;;;
;; 
;; (autoload 'vhdl-mode "vhdl-mode" "VHDL Editing Mode" t)
;;
;; (setq auto-mode-alist (append '(("\\.vhd$"  . vhdl-mode)) auto-mode-alist))
;; (setq auto-mode-alist (append '(("\\.vhdl$" . vhdl-mode)) auto-mode-alist))
;;
;; (add-hook 'vhdl-mode-hook
;;           '(lambda ()
;;              (setq vhdl-electric t)
;;              (setq vhdl-stutter t)
;;              (setq vhdl-compiler 'v-system)
;;              (setq vhdl-upper-case-keywords nil)
;;              (setq vhdl-basic-offset 4)
;;              (setq vhdl-comment-level 2)
;;              (setq comment-column 40)
;;              (setq end-comment-column 79)
;;              (setq vhdl-keywords-colorize t)
;;              (setq vhdl-signals-colorize nil)
;;              (setq vhdl-default-colors nil)
;;              (setq vhdl-print-two-column t)
;;              (setq vhdl-print-with-fonts t)
;;              (setq vhdl-print-with-colors nil)
;;              (setq font-lock-keywords-case-fold-search t)
;;              (setq vhdl-index-menu t)
;;              (setq vhdl-sourcefile-menu t)
;;              (setq vhdl-list-indent t)
;;              (setq vhdl-empty-lines t)
;;              (setq indent-tabs-mode nil)
;;              (setq vhdl-zero "'0'")
;;              (setq vhdl-one "'1'")
;;              (setq vhdl-date-scientific-format nil)
;;              ))
;;
(defvar newfilename "")

;; Use this function to open a new file in vhdl mode.

(defun loadnewfile()
  " It loads a existing file if present or creates a new buffer"
  (interactive)
  (find-file (read-file-name "Find File: " "~\\"))
  (if (equal (point-min) (point-max) ) (funcall 'newfile))
)

(defvar present-file-type nil)
(defvar present-file-new nil)

(defun newfile()
 " This function checks whether the file is new 
   and of defined type, and then accordingly puts the header 
   in the new file, does not touch the older file"
 (interactive)

 (if (string-equal (substring (buffer-file-name) -4) '\.pin) 
   (setq present-file-type 'yes)
 )

 (if (string-equal (substring (buffer-file-name) -4) '\.arc) 
   (setq present-file-type 'yes)

 )

 (if (string-equal (substring (buffer-file-name) -4) '\.vhd) 
   (setq present-file-type 'yes)

 )
 
 (if (string-equal (substring (buffer-file-name) -4) '\.vhdl) 
   (setq present-file-type 'yes)
  
 )

 (if (equal (point-min) (point-max)) 
   (setq present-file-new 'yes)
 )
 (if (string-equal  present-file-type present-file-new) (funcall 'vhdl-header)
 ) 

 (setq present-file-type nil)
 (setq present-file-new nil)
)

(defun vhdl-header ()
  "Insert a standard VHDL file header."
  (interactive)
  (let ((start (point)))
  (insert "\
--  *****************************************************************************
--   Copyright (C) by CG-CoreEl LogicSystems, 1998
--   Title         : [title]
--   Project       : [project]
--  *****************************************************************************
--
--   File          : [filename]
--   Author        : [author]
--   Created       : [credate]
--   Revision      : [revision]
--   Last modified : [moddate]
--
--   Reference Material : [reference1]
--                        [reference2] 
--
--   Description :
--   [description]
--
--   Revision History :
--   [modhist]
--  *****************************************************************************

")
    (goto-char start)
    (search-forward "[filename]")
    (replace-match (buffer-name) t t)
    (search-forward "[author]") 
    ;;(replace-match "" t t)
    ;;(setq author (read-string "author: "))
    ;;(insert (user-full-name))     
    (replace-match (read-string "author: ") t t)
    ;;(insert "  [" (user-login-name) "@" (system-name) "]")
    (search-forward "[credate]") 
    (replace-match (setq todays-date (read-string "todays-date : ")) t t)
    ;;(insert todays-date) 
    ;;(insert-date)
    (search-forward "[revision]")
    (replace-match (read-string "Revision : ") t t )
;;  (insert revision) 
    (search-forward "[moddate]") (replace-match "" t t)
    (insert todays-date)
    ;;(insert-date)
    (search-forward "[modhist]") (replace-match "" t t)
    ;;(insert-date)
;;    (insert " : created")
    (goto-char start)
    (let (string)
    (setq string (read-string "title: "))
    (search-forward "[title]")
    (replace-match string t t)
    (setq string (read-string "project: "))
    (search-forward "[project]")
    (replace-match string t t)
    (search-forward "[reference1]")
    (replace-match "" t t)
    (setq ref1 (read-string "Reference : "))
    (insert ref1)
    (search-forward "[reference2]")
    (replace-match "" t t) 
    (setq ref2 (read-string "Reference : "))
    (insert ref2)
    (search-forward "[description]")
    (replace-match "" t t)
  )))

;;; Calls multiple component instantiation in a architecture definition
;;; The file name provided for component has to be a valid else the operation
;;; is not guaranteed. 


(defun vhdl-architecture ()
  "Insert architecture template."
  (interactive)
  (let ((margin (current-column))
	(vhdl-architecture-name)
	(position)
	(entity-exists)
	(string)
	(case-fold-search t))
    (insert-keyword "ARCHITECTURE ")
    (if (equal (setq vhdl-architecture-name (vhdl-field "name")) "")
	nil
      (insert-keyword " OF ")
      (setq position (point))
      (setq entity-exists (re-search-backward "entity \\(\\w*\\) is" nil t))
      (setq string (match-string 1))
      (goto-char position)
      (if (and entity-exists (not (equal string "")))
  	  (insert string)
        (vhdl-field "entity name"))
      (insert-keyword " IS")
;;; Added by raj 
      (funcall 'comp-instantiate-rec)
;;; 
      (if (string-equal atleastonce 'yes)
        (kill-buffer tempbuffer) 
      )
      (goto-char (point-max))
      (if (string-equal atleastonce 'yes)
        (search-backward-regexp "[ ]*End Component;")
      )
      (end-of-line 2)
      (if (string-equal atleastonce 'yes) (setq atleastonce nil))
      (vhdl-begin-end (cons vhdl-architecture-name margin))
      (vhdl-block-comment)
      )))



;; Added by raj for reading component
;;*********************************************
(defvar present-point nil)
(defvar copy-from-point nil)
(defvar contents-for-comp nil)
(defvar contents-for-insert nil)
(defvar name-of-entity nil)
(defvar copy-till-point nil)
(defvar default-point-pos nil)
(defvar present-buffer nil)
(defvar opt nil)
(defvar atleastonce nil)
;;*********************************************

(defun comp-instantiate-rec()
 " This function gives you the option of calling Instantiation of
   different components"
 (interactive)
 (setq present-buffer (buffer-name)) 
 (setq opt (read-minibuffer "Instantiate Component (yes/no) :"))	
      (if (string-equal opt 'yes)
        (funcall 'comp-instantiate)
      )
 (if (string-equal opt 'yes) 
   (funcall 'comp-instantiate-cont)
 )  
 (switch-to-buffer present-buffer)    
)  


(defun comp-instantiate-cont()
   " "
  (interactive)
  (setq opt nil)
  (setq opt (read-minibuffer " More Components (yes/no) : ") )
  (if (string-equal opt 'yes) (funcall 'comp-instantiate))
  (if (string-equal opt 'yes) (funcall 'comp-instantiate-cont)
    (switch-to-buffer present-buffer)
  ) 
)


(defun comp-instantiate()
  " This function reads the specified file and inserts the port declarations 
    starting at the current point,you have to give valid file name, otherwise
	  function will not work properly"
  (interactive)
  (setq atleastonce 'yes)
  (insert "\n")
  (save-excursion
        
     (find-file (read-file-name "Component File: " "d:\\gnu\\emacs\\bin\\"))
     ;; So that the buffer already open can be parsed for entity
     (goto-line 0)
     (setq tempbuffer (buffer-name))
     (search-forward-regexp "^[ ]*entity")
     (setq present-point (point))
     (end-of-line nil)
     (setq copy-from-point (point))
     (setq contents-for-comp nil)
     (copy-to-register contents-for-comp present-point copy-from-point nil)
     (setq name-of-entity (car contents-for-comp))
     (switch-to-buffer present-buffer)
     (insert "\n") 
     (insert "  Component  ")
     (insert "\n") 
     (search-backward " ")
     (delete-backward-char -14)
     (insert-register name-of-entity t)
     (delete-backward-char 3)
     (insert "\n")
     (switch-to-buffer tempbuffer)
     (funcall 'search-comp )
     (switch-to-buffer present-buffer)
     (insert-register contents-for-insert t)
     (insert "\n")
     (insert "  End Component;") 
  ) 
 
)

(defun search-comp()
  " This search is used for component "
  (interactive)
  (search-forward-regexp "^[ ]*end")
  (setq copy-till-point nil)
  (setq present-point (point))
  (end-of-line nil)
  (setq contents-for-comp nil)
  (copy-to-register contents-for-comp present-point (point) nil)
  (end-of-line 0)
  (setq copy-till-point (point)) 
  (setq contents-for-insert nil)
  (if (string-equal (car contents-for-comp) name-of-entity)
      (copy-to-register contents-for-insert copy-from-point copy-till-point nil)
;;      (funcall 'search-comp)
  )
   
)

;; This following settings are for mail, each user should change his file accordingly
;; Latest file as on 24 th Feb 98
(setq user-full-name '"Rajkumar")
(setq user-mail-address "rvk@cromp.ernet.in")
(setq smtpmail-default-smtp-server "cromp")
(setq smtpmail-local-domain nil)
(setq send-mail-function 'smtpmail-send-it)
(setq mail-signature-file "")

(load-library "smtpmail")
(setq smtpmail-debug-info nil)
(setq mail-host-address "192.9.200.99")
(setenv "MAILHOST" "cromp")
(setq rmail-primary-inbox-list '("po:rvk") rmail-pop-password-required t)
 

;; This initialisation is for VHDL mode
;; VHDL-MODE.EL file should be in the specified directory path
(setq win32-alt-is-meta nil)
(set-background-color "black") 
(set-foreground-color "RosyBrown") 
(set-cursor-color "purple")
;;(set-frame-height (selected-frame) 54)
;;(set-frame-width (selected-frame) 120) 
(set-default-font
          "-*-Courier New-bold-i-*-*-18-82-c-*-*-ansi-") 
(setq load-path (cons (expand-file-name "d:\gnu\emacs\lisp") load-path))
;;(add-hook 'comint-output-filter-functions 'shell-strip-ctrl-m nil t)
(autoload 'vhdl-mode "vhdl-mode" "VHDL Editing Mode" t)
(setq auto-mode-alist (append '(("\\.vhd$"  . vhdl-mode)) auto-mode-alist))
(setq auto-mode-alist (append '(("\\.vhdl$" . vhdl-mode)) auto-mode-alist))
(setq auto-mode-alist (append '(("\\.pin$"  . vhdl-mode)) auto-mode-alist))
(setq auto-mode-alist (append '(("\\.arc$" . vhdl-mode)) auto-mode-alist))
(column-number-mode "p")
(setq tab-stop-list "")
(setq tab-stop-list '(2 4 6 8 10 12 14 16 18 20 22 24 26 28 30 32 34 36 38 40 42 44 46 48 50 52 54 56 58 60 62 64 66 68 70 72 74 76 78 80 82 84 86 88 90 92 94 96 98 100 102 104 106 108 110 112 114 116 118 120 122 124 126 128 130 132 134 136 138 140))
(setq default-tab-width 2)

;;;  Initialisation for VHDL Mode ends


The following functions are used to zoom in a window and restore it.
(defvar frameconfg nil)
(defvar WindowsZoomedIn nil)

(defun save-frame-contents()
 ""
 (interactive)
 (setq frameconfg (current-frame-configuration))
 (setq WindowsZoomedIn 'Yes) 
 (delete-other-windows) 
) 

(defun restore-frame-contents()
 ""
 (interactive)
 (set-frame-configuration frameconfg)
 (setq WindowsZoomedIn nil) 
)

(defun toggle-win()
  ""
  (interactive)
  (if (string-equal WindowsZoomedIn 'Yes)(funcall 'restore-frame-contents)
      (funcall 'save-frame-contents)))
	
(defun my-split-window-vertically()
  ""
  (interactive)
  (setq WindowsZoomedIn nil)
  (split-window-vertically)
)

(defun my-split-window-horizontally()
  ""
  (interactive)
  (setq WindowsZoomedIn nil)
  (split-window-horizontally)
)


;;;**************************************************************************************
;;; These functions are written to invoke menu's with key strokes
;;; Written by Rajkumar
;;;**************************************************************************************

(defun Filemenu()
  ""
(interactive)
(setq result (x-popup-menu (list (list 145 1)(window-frame (get-buffer-window (current-buffer) t))) (lookup-key global-map [menu-bar files])))
(if result
	(let ((command (key-binding
			(apply 'vector (append '(menu-bar)
					       '(files)
					       result)))))
	  (if command
	      (command-execute command)))))

(defun Editmenu()
 ""
 (interactive)
(setq result (x-popup-menu (list (list 200 1)(window-frame (get-buffer-window (current-buffer) t))) (lookup-key global-map [menu-bar edit])))
(if result
	(let ((command (key-binding
			(apply 'vector (append '(menu-bar)
					       '(edit)
					       result)))))
	  (if command
	      (command-execute command)))))
 
(defun Searchmenu()
 ""
 (interactive)
(setq result (x-popup-menu (list (list 240 1)(window-frame (get-buffer-window (current-buffer) t))) (lookup-key global-map [menu-bar search])))
(if result
	(let ((command (key-binding
			(apply 'vector (append '(menu-bar)
					       '(search)
					       result)))))
	  (if command
	      (command-execute command)))))
 
(defun Helpmenu()
 ""
 (interactive)
(setq result (x-popup-menu (list (list 280 1)(window-frame (get-buffer-window (current-buffer) t))) (lookup-key global-map [menu-bar help-menu])))
(if result
	(let ((command (key-binding
			(apply 'vector (append '(menu-bar)
					       '(help-menu)
					       result)))))
	  (if command
	      (command-execute command)))))

(defun Buffermenu()
 ""
 (interactive)
(setq result (x-popup-menu (list (list 2 1)(window-frame (get-buffer-window (current-buffer) t))) (lookup-key global-map [menu-bar buffer])))
(if result
	(let ((command (key-binding
			(apply 'vector (append '(menu-bar)
					       '(buffer)
					       result)))))
          (setq last-command-event (car result))      
	  (if command
	      (command-execute command)))))

(defun Toolsmenu()
 ""
 (interactive)
(setq result (x-popup-menu (list (list 160 1)(window-frame (get-buffer-window (current-buffer) t))) (lookup-key global-map [menu-bar tools])))
(if result
	(let ((command (key-binding
			(apply 'vector (append '(menu-bar)
					       '(tools)
					       result)))))
	  (if command
	      (command-execute command)))))
 

 

;;;***************************************************************************************
;;;
;;;***************************************************************************************

;;;This are the changes made in Brief.el available to save the last opened
;;; files in editor and restore it on starting emacs.

(defun save-emacs-environment ()
  "Saving of all emacs environment to to file."
   (save-excursion
   (set-buffer (get-buffer-create "*emacs-environment*"))
    (let ((p1 (point)))

      ; Saving of search context
      (save-user-stack search-history-list
                       "search-history-list" search-history-list-save)

      ; Saving of replace context
      (save-user-stack replace-from-history-list
                       "replace-from-history-list" replace-history-list-save)
      (save-user-stack replace-to-history-list
                       "replace-to-history-list" replace-history-list-save)

      ; Saving of bookmark list
      (if mark-list
        (let ((i 0)(el nil))
          (insert "(setq mark-list\n  (list\n")
          (while (< i mark-max-count)
            (setq el (assoc i mark-list))
            (if el
              (insert (format "    %s\n" (prin1-to-string 
                                           (list 'list 
                                           (car el) 
                                           (car (cdr el))
                                           (car (cdr (cdr el)))
                                           (car (cdr (cdr (cdr el))))
                                           nil))))
            )
            (setq i (1+ i))
          )
          (insert "  )\n)\n")
        )
        (insert "(setq mark-list nil)\n")
      )
      (insert (format "(setq register-alist '%s)\n" 
      (find-file "c:/home/_EMACS")
                 (prin1-to-string register-alist)))
      

    (setq bl (buffer-list))
	  (while bl
	    (setq buffername (car bl))
			(setq bl (cdr bl))
		  (setq filename (buffer-file-name buffername))
		  (if filename
         (insert (format "(find-file %s)\n"
                          (prin1-to-string filename))))
		)
    ;;(window-configuration-to-register windowconfg)
    ;;(setq windowconfg (current-window-configuration))
    ;;(insert (format "(setq windowconfg %s)\n"
		;;	                   (prin1-to-string windowconfg)))
		;;(insert (format "(set-window-configuration windowconfg)\n"))

;;;      (insert (format "(setq kill-ring '%s)\n"                             
;;;                      (prin1-to-string kill-ring)))                        
;;;      (insert (format "(setq killed-rectangle '%s)\n"                      
;;;                      (prin1-to-string killed-rectangle)))                 
;;;      (insert (format "(setq kill-ring-yank-pointer '%s)\n"                
;;;                      (prin1-to-string kill-ring-yank-pointer)))           
;;;      (insert (format "(setq reg-in-scrap-flag '%s)\n" reg-in-scrap-flag)) 
         
      (write-region p1 (point) save-environment-filename)
    )
    (kill-buffer "*emacs-environment*")
  )
)

;; This restores the previous session files.
(and
  (file-exists-p   save-environment-filename)
  (file-readable-p save-environment-filename)
;  (load-file       save-environment-filename)
)


Back To Main Page: