Download
(defgroup whdl nil "Some customizations of whdl packages" :group 'local)
(defcustom use-ido-find-file t
"*If t, ido-find-file functions are used for asking for buffers. If nil, standard emacs functions are used."
:type 'boolean :group 'whdl)
(defcustom allowed-chars-in-signal "a-z0-9A-Z_"
"*This regexp determins what characters of a signal or constant or function name are allowed.
Needed to determine end of name."
:type 'string :group 'whdl)
(defcustom allowed-chars-in-signal-plus "a-z0-9A-Z_-"
"*This regexp determins what characters of a signal or constant or function name are allowed.
Needed to determine end of name."
:type 'string :group 'whdl)
(defun whdl-get-name (&optional dont-downcase)
"This function extracts word at current position. To determine end of word, allowed-chars-in-signal is used."
(save-excursion
(re-search-forward (concat " *[" allowed-chars-in-signal "]*"))
(backward-char)
(if (not dont-downcase)
(downcase (buffer-substring-no-properties (1+ (point)) (+ (re-search-backward (concat "[^"allowed-chars-in-signal "]")) 1)))
(buffer-substring-no-properties (1+ (point)) (+ (re-search-backward (concat "[^"allowed-chars-in-signal "]")) 1)))))
(defun whdl-get-name-plus (&optional dont-downcase)
"This function extracts word at current position. To determine end of word, allowed-chars-in-signal is used."
(save-excursion
(re-search-forward (concat " *[" allowed-chars-in-signal-plus "]*"))
(backward-char)
(if (not dont-downcase)
(downcase (buffer-substring-no-properties (1+ (point)) (+ (re-search-backward (concat "[^"allowed-chars-in-signal "]")) 1)))
(buffer-substring-no-properties (1+ (point)) (+ (re-search-backward (concat "[^"allowed-chars-in-signal "]")) 1)))))
(defun whdl-package-names ()
"Gets all used packages of a vhdl file. Only use work.NAME.blabla is valid. Returns all NAME"
(save-excursion
(let ((packages '()))
(goto-char (point-min))
(while (re-search-forward "^ *use *work\." nil t nil)
(forward-char)
(push (whdl-get-name) packages))
(if (whdl-set-entity-of-arch)
(while (re-search-forward "^ *use *work\." nil t nil)
(forward-char)
(push (whdl-get-name) packages)))
packages)))
(defun whdl-set-entity-of-arch ()
(let ((package-buffer))
(if (equal (whdl-get-entity-or-package-name) "")
(if (setq package-buffer (whdl-get-buffer (whdl-get-entity-name-of-architecture)))
(progn
(set-buffer package-buffer)
(goto-char (point-min)))
(if (setq package-buffer (whdl-ask-for-package (concat (whdl-get-entity-name-of-architecture) " entity file")))
(progn
(set-buffer package-buffer)
(goto-char (point-min))))))
(if package-buffer t nil)))
(defun whdl-get-buffer (entity-or-package-name)
"Returns buffer where entity-or-package-name is found. Buffer must exist"
(save-excursion
(let ((current-buffer-list (buffer-list)) (counter 0) found)
(while (and (nth counter current-buffer-list) (not found))
(set-buffer (nth counter current-buffer-list))
(if (equal entity-or-package-name (whdl-get-entity-or-package-name))
(setq found t)
(setq counter (1+ counter))))
(if found
(nth counter current-buffer-list)
nil))))
(defun whdl-get-entity-or-package-name ()
"Extracts name of a entity or of a package"
(save-excursion
(goto-char (point-min))
(if (re-search-forward "^ *\\(entity\\|package\\) +" nil t nil)
(whdl-get-name-plus)
"")))
(defun whdl-get-entity-name-of-architecture()
"Extracts name of architecture if present, returns empty string if nothing found"
(save-excursion
(goto-char (point-min))
(if (re-search-forward "\\(^\\)\\s-*architecture\\s-+[a-zA-Z0-9_]+\\s-+of\\s-+" nil t nil)
(whdl-get-name)
"")))
(defun whdl-ask-for-package (package-name)
(if use-ido-find-file
(let ((ido-current-directory (expand-file-name (file-name-directory (buffer-file-name))))
filename)
(let (ido-saved-vc-mt
(vc-master-templates (and (boundp 'vc-master-templates) vc-master-templates))
(ido-work-directory-index -1)
(ido-work-file-index -1)
(ido-find-literal nil))
(unless filename
(setq ido-saved-vc-mt vc-master-templates)
(setq filename (ido-read-internal 'file
(concat "Where is '" package-name "? ")
'ido-file-history nil nil nil))))
(setq filename (concat ido-current-directory filename))
(find-file-noselect filename))
(read-file-name (concat "Where is '" package-name "? "))))
(defun whdl-process-file (name)
"searches a package or a vhdl file for name and tests if it is a type definition or not"
(let ((found nil) should-be-in-entity beginning-of-entity-port end-of-entity end-of-entity-port apoint (current-pos (point)))
(save-excursion
(goto-char (point-min))
(setq beginning-of-entity-port (re-search-forward (concat "^[ \t]*entity[ \n\t]+[" allowed-chars-in-signal "]+[ \n\t]+is") nil t nil))
(if beginning-of-entity-port
(progn
(setq end-of-entity (save-excursion (re-search-forward "^[ \t]*end")))
(re-search-forward "port[ \n\t]*(" nil t nil)
(setq end-of-entity-port (progn (up-list) (point)))
(goto-char (point-min))
(setq should-be-in-entity (re-search-forward (concat " +" name "[ \n\t]+") nil t nil))
(if (and should-be-in-entity (< beginning-of-entity-port should-be-in-entity) (> end-of-entity-port should-be-in-entity)
(< (save-excursion (re-search-forward ":" nil t nil)) (save-excursion (re-search-forward "\n" nil t nil)))
(< (point) (save-excursion (re-search-forward ":" nil t nil)))
(< end-of-entity-port end-of-entity))
(setq found (point)))))
(goto-char (point-min))
(while (and (not found) (re-search-forward "^ *\\(component\\|function\\|procedure\\|constant\\|file\\|type\\|subtype\\)[ \n\t]+" nil t nil))
(if (equal name (whdl-get-name))
(setq found (point))))
(goto-char (point-min))
(while (and (not found) (re-search-forward "^[ \t]*signal[ \n\t]+" nil t nil))
(if (equal name (whdl-get-name))
(setq found (point))
(while (> (save-excursion (search-forward ":" nil t nil)) (if (setq apoint (save-excursion (search-forward "," nil t nil))) apoint 0))
(search-forward "," nil t nil)
(if (equal name (whdl-get-name))
(setq found (point)))))))
(if found found nil)))
(defun vhdl-goto-type-def ()
"Main fuction. Reads word at cursor and tries to find a corresponding signal or type definition.
This function first tries to find a signal or type definition in the buffer from where the function have
been called. It can only jump to signal, constant, type and subtype definitions. Works also for signals in
an entity (in and out ports, function will then jump to the entity). To go back to the point where the function
has been called press `\C-x\C-x'.
If there was nothing found, it reads the packages used, and works through all opened buffers to find packages used
in the vhdl file. If a definition has been found in a package, package will be displayed. To go back to original
vhdl file press `\C-x b RET'."
(interactive)
(setq current-pos (point))
(if (not (setq found (whdl-process-file (whdl-get-name))))
(let ((to-search-for (whdl-get-name)) (package-list (whdl-package-names))
(counter 0) found package-buffer (to-open-packages '()))
(while (and (not found) (nth counter package-list))
(setq package-buffer (whdl-get-buffer (nth counter package-list)))
(if (not package-buffer)
(setq to-open-packages (append (list (nth counter package-list)) to-open-packages))
(save-excursion
(set-buffer package-buffer)
(setq found (whdl-process-file to-search-for))))
(setq counter (1+ counter)))
(setq counter 0)
(if (not found)
(save-excursion
(if (whdl-set-entity-of-arch)
(progn
(setq found (whdl-process-file to-search-for))
(setq package-buffer (current-buffer))))))
(while (and (not found) (nth counter to-open-packages))
(if (setq package-buffer (whdl-ask-for-package (nth counter to-open-packages)))
(save-excursion
(set-buffer package-buffer)
(setq found (whdl-process-file to-search-for))))
(setq counter (1+ counter)))
(if found
(progn
(switch-to-buffer package-buffer)
(goto-char found)
(recenter))
(message "sorry, no corresponding definition found")))
(progn
(push-mark current-pos t nil)
(goto-char found)
(beginning-of-line)
(recenter))))
(provide 'vhdl-goto-def)