;;; vhdl-mode.el --- major mode for editing VHDL code
;; Copyright (C) 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
-;; 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+;; Free Software Foundation, Inc.
;; Authors: Reto Zimmermann <reto@gnu.org>
;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
;; Keywords: languages vhdl
;; WWW: http://www.iis.ee.ethz.ch/~zimmi/emacs/vhdl-mode.html
+;; Yoni Rabkin <yoni@rabkins.net> contacted the maintainer of this
+;; file on 18/3/2008, and the maintainer agreed that when a bug is
+;; filed in the Emacs bug reporting system against this file, a copy
+;; of the bug report be sent to the maintainer's email address.
+
(defconst vhdl-version "3.33.6"
"VHDL Mode version number.")
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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.
+;; the Free Software Foundation, either version 3 of the License, 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
;; 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, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Commentary:
;;; Code:
-;; XEmacs handling
-(defconst vhdl-xemacs (string-match "XEmacs" emacs-version)
- "Non-nil if XEmacs is used.")
;; Emacs 21+ handling
-(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not vhdl-xemacs))
+(defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs)))
"Non-nil if GNU Emacs 21, 22, ... is used.")
-(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not vhdl-xemacs))
+(defconst vhdl-emacs-22 (and (<= 22 emacs-major-version) (not (featurep 'xemacs)))
"Non-nil if GNU Emacs 22, ... is used.")
(defvar compilation-file-regexp-alist)
(concat
"*Specifies how the name for the components package is obtained.
The components package is a package containing all component declarations for
-the current design. It's name can be obtained by modifying the project name
+the current design. Its name can be obtained by modifying the project name
\(e.g. attaching or stripping off a substring). If no project is defined, the
DIRECTORY entry is chosen."
vhdl-name-doc-string)
;; add related general customizations
(custom-add-to-group 'vhdl-related 'hideshow 'custom-group)
-(if vhdl-xemacs
+(if (featurep 'xemacs)
(custom-add-to-group 'vhdl-related 'paren-mode 'custom-variable)
(custom-add-to-group 'vhdl-related 'paren-showing 'custom-group))
(custom-add-to-group 'vhdl-related 'ps-print 'custom-group)
(custom-add-to-group 'vhdl-related 'speedbar 'custom-group)
(custom-add-to-group 'vhdl-related 'line-number-mode 'custom-variable)
-(unless vhdl-xemacs
+(unless (featurep 'xemacs)
(custom-add-to-group 'vhdl-related 'transient-mark-mode 'custom-variable))
(custom-add-to-group 'vhdl-related 'user-full-name 'custom-variable)
(custom-add-to-group 'vhdl-related 'mail-host-address 'custom-variable)
(defun vhdl-keep-region-active ()
"Do whatever is necessary to keep the region active in XEmacs.
Ignore byte-compiler warnings you might see."
- (and (boundp 'zmacs-region-stays)
+ (and (featurep 'xemacs)
(setq zmacs-region-stays t)))
;; `wildcard-to-regexp' is included only in XEmacs 21
newstr)))
;; `itimer.el': idle timer bug fix in version 1.09 (XEmacs 21.1.9)
-(when (and vhdl-xemacs (string< itimer-version "1.09")
+(when (and (featurep 'xemacs) (string< itimer-version "1.09")
(not noninteractive))
(load "itimer")
(when (string< itimer-version "1.09")
(insert-file-contents filename t)))
(defun vhdl-sort-alist (alist)
- "Sort alist."
+ "Sort ALIST."
(sort alist (function (lambda (a b) (string< (car a) (car b))))))
(defun vhdl-get-subdirs (directory)
(defun vhdl-show-messages ()
"Get *Messages* buffer to show recent messages."
(interactive)
- (display-buffer (if vhdl-xemacs " *Message-Log*" "*Messages*")))
+ (display-buffer (if (featurep 'xemacs) " *Message-Log*" "*Messages*")))
(defun vhdl-use-direct-instantiation ()
"Return whether direct instantiation is used."
(define-key vhdl-mode-map "\M-\C-u" 'vhdl-backward-up-list)
(define-key vhdl-mode-map "\M-\C-a" 'vhdl-backward-same-indent)
(define-key vhdl-mode-map "\M-\C-e" 'vhdl-forward-same-indent)
- (unless vhdl-xemacs ; would override `M-backspace' in XEmacs
+ (unless (featurep 'xemacs) ; would override `M-backspace' in XEmacs
(define-key vhdl-mode-map "\M-\C-h" 'vhdl-mark-defun))
(define-key vhdl-mode-map "\M-\C-q" 'vhdl-indent-sexp)
(define-key vhdl-mode-map "\M-^" 'vhdl-delete-indentation)
(define-key vhdl-mode-map "\C-c\C-p\C-i" 'vhdl-port-paste-instance)
(define-key vhdl-mode-map "\C-c\C-p\C-s" 'vhdl-port-paste-signals)
(define-key vhdl-mode-map "\C-c\C-p\M-c" 'vhdl-port-paste-constants)
- (if vhdl-xemacs ; `... C-g' not allowed in XEmacs
+ (if (featurep 'xemacs) ; `... C-g' not allowed in XEmacs
(define-key vhdl-mode-map "\C-c\C-p\M-g" 'vhdl-port-paste-generic-map)
(define-key vhdl-mode-map "\C-c\C-p\C-g" 'vhdl-port-paste-generic-map))
(define-key vhdl-mode-map "\C-c\C-p\C-z" 'vhdl-port-paste-initializations)
(define-key vhdl-mode-map "\C-c\C-s\C-b" 'vhdl-subprog-paste-body)
(define-key vhdl-mode-map "\C-c\C-s\C-c" 'vhdl-subprog-paste-call)
(define-key vhdl-mode-map "\C-c\C-s\C-f" 'vhdl-subprog-flatten)
- (define-key vhdl-mode-map "\C-c\C-c\C-n" 'vhdl-compose-new-component)
- (define-key vhdl-mode-map "\C-c\C-c\C-p" 'vhdl-compose-place-component)
- (define-key vhdl-mode-map "\C-c\C-c\C-w" 'vhdl-compose-wire-components)
- (define-key vhdl-mode-map "\C-c\C-c\C-f" 'vhdl-compose-configuration)
- (define-key vhdl-mode-map "\C-c\C-c\C-k" 'vhdl-compose-components-package)
- (define-key vhdl-mode-map "\C-cc" 'vhdl-comment-uncomment-region)
+ (define-key vhdl-mode-map "\C-c\C-m\C-n" 'vhdl-compose-new-component)
+ (define-key vhdl-mode-map "\C-c\C-m\C-p" 'vhdl-compose-place-component)
+ (define-key vhdl-mode-map "\C-c\C-m\C-w" 'vhdl-compose-wire-components)
+ (define-key vhdl-mode-map "\C-c\C-m\C-f" 'vhdl-compose-configuration)
+ (define-key vhdl-mode-map "\C-c\C-m\C-k" 'vhdl-compose-components-package)
+ (define-key vhdl-mode-map "\C-c\C-c" 'vhdl-comment-uncomment-region)
(define-key vhdl-mode-map "\C-c-" 'vhdl-comment-append-inline)
(define-key vhdl-mode-map "\C-c\M--" 'vhdl-comment-display-line)
(define-key vhdl-mode-map "\C-c\C-i\C-l" 'indent-according-to-mode)
(define-key vhdl-mode-map "\C-c\C-b" 'vhdl-beautify-buffer)
(define-key vhdl-mode-map "\C-c\C-u\C-s" 'vhdl-update-sensitivity-list-process)
(define-key vhdl-mode-map "\C-c\C-u\M-s" 'vhdl-update-sensitivity-list-buffer)
- (define-key vhdl-mode-map "\C-cf" 'vhdl-fontify-buffer)
- (define-key vhdl-mode-map "\C-cs" 'vhdl-statistics-buffer)
+ (define-key vhdl-mode-map "\C-c\C-i\C-f" 'vhdl-fontify-buffer)
+ (define-key vhdl-mode-map "\C-c\C-i\C-s" 'vhdl-statistics-buffer)
(define-key vhdl-mode-map "\C-c\M-m" 'vhdl-show-messages)
(define-key vhdl-mode-map "\C-c\C-h" 'vhdl-doc-mode)
(define-key vhdl-mode-map "\C-c\C-v" 'vhdl-version)
;; set up electric character functions to work with
;; `delete-selection-mode' (Emacs) and `pending-delete-mode' (XEmacs)
-(mapcar
+(mapc
(function
(lambda (sym)
(put sym 'delete-selection t) ; for `delete-selection-mode' (Emacs)
(defun vhdl-set-offset (symbol offset &optional add-p)
"Change the value of a syntactic element symbol in `vhdl-offsets-alist'.
SYMBOL is the syntactic element symbol to change and OFFSET is the new
-offset for that syntactic element. Optional ADD says to add SYMBOL to
+offset for that syntactic element. Optional ADD-P says to add SYMBOL to
`vhdl-offsets-alist' if it doesn't already appear there."
(interactive
(let* ((langelem
(or vars
(error "ERROR: Invalid VHDL indentation style `%s'" style))
;; set all the variables
- (mapcar
+ (mapc
(function
(lambda (varentry)
(let ((var (car varentry))
(skip-chars-forward " \t\n"))))
;; XEmacs hack: work around buggy `forward-comment' in XEmacs 21.4+
-(unless (and vhdl-xemacs (string< "21.2" emacs-version))
+(unless (and (featurep 'xemacs) (string< "21.2" emacs-version))
(defalias 'vhdl-forward-comment 'forward-comment))
;; This is the best we can do in Win-Emacs.
"If the word at the current position corresponds to an \"end\"
keyword, then return a vector containing enough information to find
the corresponding \"begin\" keyword, else return nil. The keyword to
-search backward for is aref 0. The column in which the keyword must
+search backward for is aref 0. The column in which the keyword must
appear is aref 1 or nil if any column is suitable. The supplementary
keyword to search forward for is aref 2 or nil if this is not
required. If aref 3 is t, then the \"begin\" keyword may be found in
;; Defuns for calculating the current syntactic state:
(defun vhdl-get-library-unit (bod placeholder)
- "If there is an enclosing library unit at bod, with it's \"begin\"
-keyword at placeholder, then return the library unit type."
+ "If there is an enclosing library unit at BOD, with its \"begin\"
+keyword at PLACEHOLDER, then return the library unit type."
(let ((here (vhdl-point 'bol)))
(if (save-excursion
(goto-char placeholder)
(defun vhdl-get-block-state (&optional lim)
"Finds and records all the closest opens.
-lim is the furthest back we need to search (it should be the
+LIM is the furthest back we need to search (it should be the
previous libunit keyword)."
(let ((here (point))
(lim (or lim (point-min)))
(defun vhdl-skip-case-alternative (&optional lim)
"Skip forward over case/when bodies, with optional maximal
-limit. If no next case alternative is found, nil is returned and point
-is not moved."
+limit. If no next case alternative is found, nil is returned and
+point is not moved."
(let ((lim (or lim (point-max)))
(here (point))
donep foundp)
(defun vhdl-backward-skip-label (&optional lim)
"Skip backward over a label, with optional maximal
-limit. If label is not found, nil is returned and point
+limit. If label is not found, nil is returned and point
is not moved."
(let ((lim (or lim (point-min)))
placeholder)
(when (and vhdl-progress-info (not noninteractive)
(< vhdl-progress-interval
(- (nth 1 (current-time)) (aref vhdl-progress-info 2))))
- (message (concat string "... (%2d%s)")
- (/ (* 100 (- pos (aref vhdl-progress-info 0)))
- (- (aref vhdl-progress-info 1)
- (aref vhdl-progress-info 0))) "%")
+ (let ((delta (- (aref vhdl-progress-info 1)
+ (aref vhdl-progress-info 0))))
+ (if (= 0 delta)
+ (message (concat string "... (100%s)") "%")
+ (message (concat string "... (%2d%s)")
+ (/ (* 100 (- pos (aref vhdl-progress-info 0)))
+ delta) "%")))
(aset vhdl-progress-info 2 (nth 1 (current-time)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(indent-to comment-column)
(indent-according-to-mode))
(t ; inline comment indent
- (kill-line -0))))
+ (delete-region (line-beginning-position) (point)))))
;; dedent
((and (>= (current-indentation) vhdl-basic-offset)
(or (eq last-command 'vhdl-electric-tab)
(actual (vhdl-get-syntactic-context))
(expurgated))
;; remove the library unit symbols
- (mapcar
+ (mapc
(function
(lambda (elt)
(if (memq (car elt) '(entity configuration package
(when (not (looking-at "^\\s-*\\(--.*\\)?$"))
(end-of-line)
(if (search-backward " -- ((" (vhdl-point 'bol) t)
- (kill-line))
+ (delete-region (point) (line-end-position)))
(insert " -- ")
(insert (format "%s" expurgated))))))
(vhdl-keep-region-active))
(defun vhdl-align-region-2 (begin end match &optional substr spacing)
"Align a range of lines from BEGIN to END. The regular expression
-MATCH must match exactly one fields: the whitespace to be
+MATCH must match exactly one field: the whitespace to be
contracted/expanded. The alignment column will equal the
-rightmost column of the widest whitespace block. SPACING is
+rightmost column of the widest whitespace block. SPACING is
the amount of extra spaces to add to the calculated maximum required.
SPACING defaults to 1 so that at least one space is inserted after
the token in MATCH."
(defun vhdl-electric-dash (count)
"-- starts a comment, --- draws a horizontal line,
----- starts a display comment"
+---- starts a display comment."
(interactive "p")
(if (and vhdl-stutter-mode (not (vhdl-in-literal)))
(cond
(progn (vhdl-insert-keyword "FOR ")
(if (vhdl-template-field "[quantity name]" " USE " t)
(progn (vhdl-template-field "quantity name" " => ") t)
- (kill-word -1) nil))
+ (delete-region (point)
+ (progn (forward-word -1) (point)))
+ nil))
(vhdl-template-field "[quantity name]" " => " t))
(vhdl-template-field "expression")
(setq position (point))
(setq position (point))
(vhdl-insert-keyword "PORT ")
(unless (vhdl-template-map position t t)
- (kill-line -0)
+ (delete-region (line-beginning-position) (point))
(delete-char -1))
(insert ";"))))
(setq position (point))
(vhdl-insert-keyword "PORT ")
(unless (vhdl-template-map position t t)
- (kill-line -0)
+ (delete-region (line-beginning-position) (point))
(delete-char -1))
(insert ";")
t)
(progn (delete-region (point) (progn (end-of-line) (point)))
(vhdl-template-insert-date))
(unless noerror
- (error (concat "ERROR: Modification date prefix string \""
- vhdl-modify-date-prefix-string "\" not found")))))))
+ (error "ERROR: Modification date prefix string \"%s\" not found"
+ vhdl-modify-date-prefix-string))))))
+
(defun vhdl-template-modify-noerror ()
"Call `vhdl-template-modify' with NOERROR non-nil."
(cond ((equal definition "")
(insert ";"))
((equal definition "ARRAY")
- (kill-word -1)
+ (delete-region (point) (progn (forward-word -1) (point)))
(vhdl-template-array 'nature t))
((equal definition "RECORD")
(setq mid-pos (point-marker))
- (kill-word -1)
+ (delete-region (point) (progn (forward-word -1) (point)))
(vhdl-template-record 'nature name t))
(t
(vhdl-insert-keyword " ACROSS ")
(insert "\n")
(indent-to (+ margin vhdl-basic-offset))
(setq first nil))
- (kill-line -0)
+ (delete-region (line-beginning-position) (point))
(indent-to margin)
(vhdl-insert-keyword "END RECORD")
(unless (vhdl-standard-p '87) (and name (insert " " name)))
(delete-backward-char 4)
(insert ";"))
((equal definition "ARRAY")
- (kill-word -1)
+ (delete-region (point) (progn (forward-word -1) (point)))
(vhdl-template-array 'type t))
((equal definition "RECORD")
(setq mid-pos (point-marker))
- (kill-word -1)
+ (delete-region (point) (progn (forward-word -1) (point)))
(vhdl-template-record 'type name t))
((equal definition "ACCESS")
(insert " ")
"Query a decision from the user."
(let ((start (point)))
(when string (vhdl-insert-keyword (concat string " ")))
- (message prompt)
+ (message "%s" (or prompt ""))
(let ((char (read-char)))
(delete-region start (point))
(if (and optional (eq char ?\r))
(if vhdl-upper-case-keywords (upcase keyword) (downcase keyword)))
(defun vhdl-case-word (num)
- "Adjust case or following NUM words."
+ "Adjust case of following NUM words."
(if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)))
(defun vhdl-minibuffer-tab (&optional prefix-arg)
(defun vhdl-hooked-abbrev (func)
"Do function, if syntax says abbrev is a keyword, invoked by hooked abbrev,
-but not if inside a comment or quote)."
+but not if inside a comment or quote."
(if (or (vhdl-in-literal)
(save-excursion
(forward-word -1)
;; Case fixing
(defun vhdl-fix-case-region-1 (beg end upper-case word-regexp &optional count)
- "Convert all words matching word-regexp in region to lower or upper case,
-depending on parameter upper-case."
+ "Convert all words matching WORD-REGEXP in region to lower or upper case,
+depending on parameter UPPER-CASE."
(let ((case-replace nil)
(last-update 0))
(vhdl-prepare-search-2
"Regexp to match start of construct to hide.")
(defun vhdl-hs-forward-sexp-func (count)
- "Find end of construct to hide (for hideshow). Only searches forward."
+ "Find end of construct to hide (for hideshow). Only searches forward."
(let ((pos (point)))
(vhdl-prepare-search-2
(beginning-of-line)
(goto-char end))))))
(defun vhdl-font-lock-match-item (limit)
- "Match, and move over, any declaration item after point. Adapted from
+ "Match, and move over, any declaration item after point. Adapted from
`font-lock-match-c-style-declaration-item-and-skip-to-next'."
(condition-case nil
(save-restriction
(defun vhdl-ps-print-init ()
"Initialize postscript printing."
- (if vhdl-xemacs
+ (if (featurep 'xemacs)
(when (boundp 'ps-print-color-p)
(vhdl-ps-print-settings))
(make-local-variable 'ps-print-hook)
(defun vhdl-scan-directory-contents (name &optional project update num-string
non-final)
- "Scan contents of VHDL files in directory or file pattern DIR-NAME."
+ "Scan contents of VHDL files in directory or file pattern NAME."
(string-match "\\(.*[/\\]\\)\\(.*\\)" name)
; (unless (file-directory-p (match-string 1 name))
; (message "No such directory: \"%s\"" (match-string 1 name)))
(save-excursion (beginning-of-line) (looking-at "[0-9]+:"))]
["Rescan Directory" vhdl-speedbar-rescan-hierarchy
:active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
- ,(if vhdl-xemacs :active :visible) (not vhdl-speedbar-show-projects)]
+ ,(if (featurep 'xemacs) :active :visible) (not vhdl-speedbar-show-projects)]
["Rescan Project" vhdl-speedbar-rescan-hierarchy
:active (save-excursion (beginning-of-line) (looking-at "[0-9]+:"))
- ,(if vhdl-xemacs :active :visible) vhdl-speedbar-show-projects]
+ ,(if (featurep 'xemacs) :active :visible) vhdl-speedbar-show-projects]
["Save Caches" vhdl-save-caches vhdl-updated-project-list])))
;; hook-ups
(speedbar-add-expansion-list
)
(defun vhdl-speedbar-insert-project-hierarchy (project indent &optional rescan)
- "Insert hierarchy of project. Rescan directories if RESCAN is non-nil,
+ "Insert hierarchy of PROJECT. Rescan directories if RESCAN is non-nil,
otherwise use cached data."
(when (or rescan (and (not (assoc project vhdl-file-alist))
(not (vhdl-load-cache project))))
(goto-line (cdr token))
(recenter))
(vhdl-speedbar-update-current-unit t t)
- (speedbar-set-timer speedbar-update-speed)
+ (speedbar-set-timer dframe-update-speed)
(speedbar-maybee-jump-to-attached-frame))))
(defun vhdl-speedbar-port-copy ()
(assoc (car sublist) regexp-alist))
(setq regexp-alist (cons (list (nth 0 sublist)
(if (= 0 (nth 1 sublist))
- (if vhdl-xemacs 9 nil)
+ (if (featurep 'xemacs) 9 nil)
(nth 1 sublist))
(nth 2 sublist) (nth 3 sublist))
regexp-alist)))
(defun vhdl-doc-variable (variable)
"Display VARIABLE's documentation in *Help* buffer."
(interactive)
- (unless vhdl-xemacs
+ (unless (featurep 'xemacs)
(help-setup-xref (list #'vhdl-doc-variable variable) (interactive-p)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")
(defun vhdl-doc-mode ()
"Display VHDL Mode documentation in *Help* buffer."
(interactive)
- (unless vhdl-xemacs
+ (unless (featurep 'xemacs)
(help-setup-xref (list #'vhdl-doc-mode) (interactive-p)))
(with-output-to-temp-buffer
(if (fboundp 'help-buffer) (help-buffer) "*Help*")