;;; 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, 2008
-;; Free Software Foundation, Inc.
+;; Copyright (C) 1992-2011 Free Software Foundation, Inc.
;; Authors: Reto Zimmermann <reto@gnu.org>
;; Rodney J. Whitby <software.vhdl-mode@rwhitby.net>
;; - Word/keyword completion
;; - Block commenting
;; - Code fixing/alignment/beautification
-;; - Postscript printing
+;; - PostScript printing
;; - VHDL'87/'93 and VHDL-AMS supported
;; - Comprehensive menu
;; - Fully customizable
"Customizations for modes."
:group 'vhdl)
-(defcustom vhdl-electric-mode t
- "*Non-nil enables electrification (automatic template generation).
-If nil, template generators can still be invoked through key bindings and
-menu. Is indicated in the modeline by \"/e\" after the mode name and can be
-toggled by `\\[vhdl-electric-mode]'."
- :type 'boolean
- :group 'vhdl-mode)
-
-(defcustom vhdl-stutter-mode t
- "*Non-nil enables stuttering.
-Is indicated in the modeline by \"/s\" after the mode name and can be toggled
-by `\\[vhdl-stutter-mode]'."
- :type 'boolean
- :group 'vhdl-mode)
-
(defcustom vhdl-indent-tabs-mode nil
"*Non-nil means indentation can insert tabs.
Overrides local variable `indent-tabs-mode'."
The following keywords for template generation are supported:
<filename> : replaced by the name of the buffer
<author> : replaced by the user name and email address
- \(`user-full-name',`mail-host-address', `user-mail-address')
+ \(`user-full-name', `mail-host-address', `user-mail-address')
<login> : replaced by user login name (`user-login-name')
<company> : replaced by contents of option `vhdl-company-name'
<date> : replaced by the current date
(defgroup vhdl-menu nil
- "Customizations for menues."
+ "Customizations for menus."
:group 'vhdl)
(defcustom vhdl-index-menu nil
(defcustom vhdl-print-two-column t
"*Non-nil means print code in two columns and landscape format.
-Adjusts settings in a way that postscript printing (\"File\" menu, `ps-print')
+Adjusts settings in a way that PostScript printing (\"File\" menu, `ps-print')
prints VHDL files in a nice two-column landscape style.
NOTE: Activate the new setting by restarting Emacs.
:group 'vhdl-print)
(defcustom vhdl-print-customize-faces t
- "*Non-nil means use an optimized set of faces for postscript printing.
+ "*Non-nil means use an optimized set of faces for PostScript printing.
NOTE: Activate the new setting by restarting Emacs.
Overrides `ps-print' settings locally."
(defcustom vhdl-intelligent-tab t
"*Non-nil means `TAB' does indentation, word completion and tab insertion.
-That is, if preceeding character is part of a word then complete word,
+That is, if preceding character is part of a word then complete word,
else if not at beginning of line then insert tab,
else if last command was a `TAB' or `RET' then dedent one step,
else indent current line (i.e. `TAB' is bound to `vhdl-electric-tab').
;; Internal variables
(defvar vhdl-menu-max-size 20
- "*Specifies the maximum size of a menu before splitting it into submenues.")
+ "*Specifies the maximum size of a menu before splitting it into submenus.")
(defvar vhdl-progress-interval 1
"*Interval used to update progress status during long operations.
comment -- a line containing only a comment
arglist-intro -- the first line in an argument list
arglist-cont -- subsequent argument list lines when no
- arguments follow on the same line as the
+ arguments follow on the same line as
the arglist opening paren
arglist-cont-nonempty -- subsequent argument list lines when at
least one argument follows on the same
(if (fboundp 'start-itimer)
(start-itimer "vhdl-mode" function secs repeat t)
; (run-with-idle-timer secs repeat function)))
- ;; explicitely activate timer (necessary when Emacs is already idle)
+ ;; explicitly activate timer (necessary when Emacs is already idle)
(aset (run-with-idle-timer secs repeat function) 0 nil)))
(defun vhdl-warning-when-idle (&rest args)
"Enable case insensitive search and switch to syntax table that includes '_',
then execute BODY, and finally restore the old environment. Used for
consistent searching."
- `(let ((case-fold-search t) ; case insensitive search
- (current-syntax-table (syntax-table))
- result
- (restore-prog ; program to restore enviroment
- '(progn
- ;; restore syntax table
- (set-syntax-table current-syntax-table))))
+ `(let ((case-fold-search t)) ; case insensitive search
;; use extended syntax table
- (set-syntax-table vhdl-mode-ext-syntax-table)
- ;; execute BODY safely
- (setq result
- (condition-case info
- (progn ,@body)
- (error (eval restore-prog) ; restore environment on error
- (error (cadr info))))) ; pass error up
- ;; restore environment
- (eval restore-prog)
- result))
+ (with-syntax-table vhdl-mode-ext-syntax-table
+ ,@body)))
(defmacro vhdl-prepare-search-2 (&rest body)
"Enable case insensitive search, switch to syntax table that includes '_',
and remove `intangible' overlays, then execute BODY, and finally restore the
old environment. Used for consistent searching."
+ ;; FIXME: Why not just let-bind `inhibit-point-motion-hooks'? --Stef
`(let ((case-fold-search t) ; case insensitive search
(current-syntax-table (syntax-table))
- result overlay-all-list overlay-intangible-list overlay
- (restore-prog ; program to restore enviroment
- '(progn
- ;; restore syntax table
- (set-syntax-table current-syntax-table)
- ;; restore `intangible' overlays
- (when (fboundp 'overlay-lists)
- (while overlay-intangible-list
- (overlay-put (car overlay-intangible-list) 'intangible t)
- (setq overlay-intangible-list
- (cdr overlay-intangible-list)))))))
+ overlay-all-list overlay-intangible-list overlay)
;; use extended syntax table
(set-syntax-table vhdl-mode-ext-syntax-table)
;; remove `intangible' overlays
(overlay-put overlay 'intangible nil))
(setq overlay-all-list (cdr overlay-all-list))))
;; execute BODY safely
- (setq result
- (condition-case info
- (progn ,@body)
- (error (eval restore-prog) ; restore environment on error
- (error (cadr info))))) ; pass error up
- ;; restore environment
- (eval restore-prog)
- result))
+ (unwind-protect
+ (progn ,@body)
+ ;; restore syntax table
+ (set-syntax-table current-syntax-table)
+ ;; restore `intangible' overlays
+ (when (fboundp 'overlay-lists)
+ (while overlay-intangible-list
+ (overlay-put (car overlay-intangible-list) 'intangible t)
+ (setq overlay-intangible-list
+ (cdr overlay-intangible-list)))))))
(defmacro vhdl-visit-file (file-name issue-error &rest body)
"Visit file FILE-NAME and execute BODY."
(goto-char marker))
(defun vhdl-menu-split (list title)
- "Split menu LIST into several submenues, if number of
+ "Split menu LIST into several submenus, if number of
elements > `vhdl-menu-max-size'."
(if (> (length list) vhdl-menu-max-size)
(let ((remain list)
(append
(when (memq 'vhdl vhdl-electric-keywords)
;; VHDL'93 keywords
- '(
- ("--" "" vhdl-template-display-comment-hook 0)
- ("abs" "" vhdl-template-default-hook 0)
- ("access" "" vhdl-template-default-hook 0)
- ("after" "" vhdl-template-default-hook 0)
- ("alias" "" vhdl-template-alias-hook 0)
- ("all" "" vhdl-template-default-hook 0)
- ("and" "" vhdl-template-default-hook 0)
- ("arch" "" vhdl-template-architecture-hook 0)
- ("architecture" "" vhdl-template-architecture-hook 0)
- ("array" "" vhdl-template-default-hook 0)
- ("assert" "" vhdl-template-assert-hook 0)
- ("attr" "" vhdl-template-attribute-hook 0)
- ("attribute" "" vhdl-template-attribute-hook 0)
- ("begin" "" vhdl-template-default-indent-hook 0)
- ("block" "" vhdl-template-block-hook 0)
- ("body" "" vhdl-template-default-hook 0)
- ("buffer" "" vhdl-template-default-hook 0)
- ("bus" "" vhdl-template-default-hook 0)
- ("case" "" vhdl-template-case-hook 0)
- ("comp" "" vhdl-template-component-hook 0)
- ("component" "" vhdl-template-component-hook 0)
- ("cond" "" vhdl-template-conditional-signal-asst-hook 0)
- ("conditional" "" vhdl-template-conditional-signal-asst-hook 0)
- ("conf" "" vhdl-template-configuration-hook 0)
- ("configuration" "" vhdl-template-configuration-hook 0)
- ("cons" "" vhdl-template-constant-hook 0)
- ("constant" "" vhdl-template-constant-hook 0)
- ("disconnect" "" vhdl-template-disconnect-hook 0)
- ("downto" "" vhdl-template-default-hook 0)
- ("else" "" vhdl-template-else-hook 0)
- ("elseif" "" vhdl-template-elsif-hook 0)
- ("elsif" "" vhdl-template-elsif-hook 0)
- ("end" "" vhdl-template-default-indent-hook 0)
- ("entity" "" vhdl-template-entity-hook 0)
- ("exit" "" vhdl-template-exit-hook 0)
- ("file" "" vhdl-template-file-hook 0)
- ("for" "" vhdl-template-for-hook 0)
- ("func" "" vhdl-template-function-hook 0)
- ("function" "" vhdl-template-function-hook 0)
- ("generic" "" vhdl-template-generic-hook 0)
- ("group" "" vhdl-template-group-hook 0)
- ("guarded" "" vhdl-template-default-hook 0)
- ("if" "" vhdl-template-if-hook 0)
- ("impure" "" vhdl-template-default-hook 0)
- ("in" "" vhdl-template-default-hook 0)
- ("inertial" "" vhdl-template-default-hook 0)
- ("inout" "" vhdl-template-default-hook 0)
- ("inst" "" vhdl-template-instance-hook 0)
- ("instance" "" vhdl-template-instance-hook 0)
- ("is" "" vhdl-template-default-hook 0)
- ("label" "" vhdl-template-default-hook 0)
- ("library" "" vhdl-template-library-hook 0)
- ("linkage" "" vhdl-template-default-hook 0)
- ("literal" "" vhdl-template-default-hook 0)
- ("loop" "" vhdl-template-bare-loop-hook 0)
- ("map" "" vhdl-template-map-hook 0)
- ("mod" "" vhdl-template-default-hook 0)
- ("nand" "" vhdl-template-default-hook 0)
- ("new" "" vhdl-template-default-hook 0)
- ("next" "" vhdl-template-next-hook 0)
- ("nor" "" vhdl-template-default-hook 0)
- ("not" "" vhdl-template-default-hook 0)
- ("null" "" vhdl-template-default-hook 0)
- ("of" "" vhdl-template-default-hook 0)
- ("on" "" vhdl-template-default-hook 0)
- ("open" "" vhdl-template-default-hook 0)
- ("or" "" vhdl-template-default-hook 0)
- ("others" "" vhdl-template-others-hook 0)
- ("out" "" vhdl-template-default-hook 0)
- ("pack" "" vhdl-template-package-hook 0)
- ("package" "" vhdl-template-package-hook 0)
- ("port" "" vhdl-template-port-hook 0)
- ("postponed" "" vhdl-template-default-hook 0)
- ("procedure" "" vhdl-template-procedure-hook 0)
- ("process" "" vhdl-template-process-hook 0)
- ("pure" "" vhdl-template-default-hook 0)
- ("range" "" vhdl-template-default-hook 0)
- ("record" "" vhdl-template-default-hook 0)
- ("register" "" vhdl-template-default-hook 0)
- ("reject" "" vhdl-template-default-hook 0)
- ("rem" "" vhdl-template-default-hook 0)
- ("report" "" vhdl-template-report-hook 0)
- ("return" "" vhdl-template-return-hook 0)
- ("rol" "" vhdl-template-default-hook 0)
- ("ror" "" vhdl-template-default-hook 0)
- ("select" "" vhdl-template-selected-signal-asst-hook 0)
- ("severity" "" vhdl-template-default-hook 0)
- ("shared" "" vhdl-template-default-hook 0)
- ("sig" "" vhdl-template-signal-hook 0)
- ("signal" "" vhdl-template-signal-hook 0)
- ("sla" "" vhdl-template-default-hook 0)
- ("sll" "" vhdl-template-default-hook 0)
- ("sra" "" vhdl-template-default-hook 0)
- ("srl" "" vhdl-template-default-hook 0)
- ("subtype" "" vhdl-template-subtype-hook 0)
- ("then" "" vhdl-template-default-hook 0)
- ("to" "" vhdl-template-default-hook 0)
- ("transport" "" vhdl-template-default-hook 0)
- ("type" "" vhdl-template-type-hook 0)
- ("unaffected" "" vhdl-template-default-hook 0)
- ("units" "" vhdl-template-default-hook 0)
- ("until" "" vhdl-template-default-hook 0)
- ("use" "" vhdl-template-use-hook 0)
- ("var" "" vhdl-template-variable-hook 0)
- ("variable" "" vhdl-template-variable-hook 0)
- ("wait" "" vhdl-template-wait-hook 0)
- ("when" "" vhdl-template-when-hook 0)
- ("while" "" vhdl-template-while-loop-hook 0)
- ("with" "" vhdl-template-with-hook 0)
- ("xnor" "" vhdl-template-default-hook 0)
- ("xor" "" vhdl-template-default-hook 0)
- ))
+ (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system))
+ '(
+ ("--" . vhdl-template-display-comment-hook)
+ ("abs" . vhdl-template-default-hook)
+ ("access" . vhdl-template-default-hook)
+ ("after" . vhdl-template-default-hook)
+ ("alias" . vhdl-template-alias-hook)
+ ("all" . vhdl-template-default-hook)
+ ("and" . vhdl-template-default-hook)
+ ("arch" . vhdl-template-architecture-hook)
+ ("architecture" . vhdl-template-architecture-hook)
+ ("array" . vhdl-template-default-hook)
+ ("assert" . vhdl-template-assert-hook)
+ ("attr" . vhdl-template-attribute-hook)
+ ("attribute" . vhdl-template-attribute-hook)
+ ("begin" . vhdl-template-default-indent-hook)
+ ("block" . vhdl-template-block-hook)
+ ("body" . vhdl-template-default-hook)
+ ("buffer" . vhdl-template-default-hook)
+ ("bus" . vhdl-template-default-hook)
+ ("case" . vhdl-template-case-hook)
+ ("comp" . vhdl-template-component-hook)
+ ("component" . vhdl-template-component-hook)
+ ("cond" . vhdl-template-conditional-signal-asst-hook)
+ ("conditional" . vhdl-template-conditional-signal-asst-hook)
+ ("conf" . vhdl-template-configuration-hook)
+ ("configuration" . vhdl-template-configuration-hook)
+ ("cons" . vhdl-template-constant-hook)
+ ("constant" . vhdl-template-constant-hook)
+ ("disconnect" . vhdl-template-disconnect-hook)
+ ("downto" . vhdl-template-default-hook)
+ ("else" . vhdl-template-else-hook)
+ ("elseif" . vhdl-template-elsif-hook)
+ ("elsif" . vhdl-template-elsif-hook)
+ ("end" . vhdl-template-default-indent-hook)
+ ("entity" . vhdl-template-entity-hook)
+ ("exit" . vhdl-template-exit-hook)
+ ("file" . vhdl-template-file-hook)
+ ("for" . vhdl-template-for-hook)
+ ("func" . vhdl-template-function-hook)
+ ("function" . vhdl-template-function-hook)
+ ("generic" . vhdl-template-generic-hook)
+ ("group" . vhdl-template-group-hook)
+ ("guarded" . vhdl-template-default-hook)
+ ("if" . vhdl-template-if-hook)
+ ("impure" . vhdl-template-default-hook)
+ ("in" . vhdl-template-default-hook)
+ ("inertial" . vhdl-template-default-hook)
+ ("inout" . vhdl-template-default-hook)
+ ("inst" . vhdl-template-instance-hook)
+ ("instance" . vhdl-template-instance-hook)
+ ("is" . vhdl-template-default-hook)
+ ("label" . vhdl-template-default-hook)
+ ("library" . vhdl-template-library-hook)
+ ("linkage" . vhdl-template-default-hook)
+ ("literal" . vhdl-template-default-hook)
+ ("loop" . vhdl-template-bare-loop-hook)
+ ("map" . vhdl-template-map-hook)
+ ("mod" . vhdl-template-default-hook)
+ ("nand" . vhdl-template-default-hook)
+ ("new" . vhdl-template-default-hook)
+ ("next" . vhdl-template-next-hook)
+ ("nor" . vhdl-template-default-hook)
+ ("not" . vhdl-template-default-hook)
+ ("null" . vhdl-template-default-hook)
+ ("of" . vhdl-template-default-hook)
+ ("on" . vhdl-template-default-hook)
+ ("open" . vhdl-template-default-hook)
+ ("or" . vhdl-template-default-hook)
+ ("others" . vhdl-template-others-hook)
+ ("out" . vhdl-template-default-hook)
+ ("pack" . vhdl-template-package-hook)
+ ("package" . vhdl-template-package-hook)
+ ("port" . vhdl-template-port-hook)
+ ("postponed" . vhdl-template-default-hook)
+ ("procedure" . vhdl-template-procedure-hook)
+ ("process" . vhdl-template-process-hook)
+ ("pure" . vhdl-template-default-hook)
+ ("range" . vhdl-template-default-hook)
+ ("record" . vhdl-template-default-hook)
+ ("register" . vhdl-template-default-hook)
+ ("reject" . vhdl-template-default-hook)
+ ("rem" . vhdl-template-default-hook)
+ ("report" . vhdl-template-report-hook)
+ ("return" . vhdl-template-return-hook)
+ ("rol" . vhdl-template-default-hook)
+ ("ror" . vhdl-template-default-hook)
+ ("select" . vhdl-template-selected-signal-asst-hook)
+ ("severity" . vhdl-template-default-hook)
+ ("shared" . vhdl-template-default-hook)
+ ("sig" . vhdl-template-signal-hook)
+ ("signal" . vhdl-template-signal-hook)
+ ("sla" . vhdl-template-default-hook)
+ ("sll" . vhdl-template-default-hook)
+ ("sra" . vhdl-template-default-hook)
+ ("srl" . vhdl-template-default-hook)
+ ("subtype" . vhdl-template-subtype-hook)
+ ("then" . vhdl-template-default-hook)
+ ("to" . vhdl-template-default-hook)
+ ("transport" . vhdl-template-default-hook)
+ ("type" . vhdl-template-type-hook)
+ ("unaffected" . vhdl-template-default-hook)
+ ("units" . vhdl-template-default-hook)
+ ("until" . vhdl-template-default-hook)
+ ("use" . vhdl-template-use-hook)
+ ("var" . vhdl-template-variable-hook)
+ ("variable" . vhdl-template-variable-hook)
+ ("wait" . vhdl-template-wait-hook)
+ ("when" . vhdl-template-when-hook)
+ ("while" . vhdl-template-while-loop-hook)
+ ("with" . vhdl-template-with-hook)
+ ("xnor" . vhdl-template-default-hook)
+ ("xor" . vhdl-template-default-hook)
+ )))
;; VHDL-AMS keywords
(when (and (memq 'vhdl vhdl-electric-keywords) (vhdl-standard-p 'ams))
- '(
- ("across" "" vhdl-template-default-hook 0)
- ("break" "" vhdl-template-break-hook 0)
- ("limit" "" vhdl-template-limit-hook 0)
- ("nature" "" vhdl-template-nature-hook 0)
- ("noise" "" vhdl-template-default-hook 0)
- ("procedural" "" vhdl-template-procedural-hook 0)
- ("quantity" "" vhdl-template-quantity-hook 0)
- ("reference" "" vhdl-template-default-hook 0)
- ("spectrum" "" vhdl-template-default-hook 0)
- ("subnature" "" vhdl-template-subnature-hook 0)
- ("terminal" "" vhdl-template-terminal-hook 0)
- ("through" "" vhdl-template-default-hook 0)
- ("tolerance" "" vhdl-template-default-hook 0)
- ))
+ (mapcar (lambda (x) (list (car x) "" (cdr x) 0 'system))
+ '(
+ ("across" . vhdl-template-default-hook)
+ ("break" . vhdl-template-break-hook)
+ ("limit" . vhdl-template-limit-hook)
+ ("nature" . vhdl-template-nature-hook)
+ ("noise" . vhdl-template-default-hook)
+ ("procedural" . vhdl-template-procedural-hook)
+ ("quantity" . vhdl-template-quantity-hook)
+ ("reference" . vhdl-template-default-hook)
+ ("spectrum" . vhdl-template-default-hook)
+ ("subnature" . vhdl-template-subnature-hook)
+ ("terminal" . vhdl-template-terminal-hook)
+ ("through" . vhdl-template-default-hook)
+ ("tolerance" . vhdl-template-default-hook)
+ )))
;; user model keywords
(when (memq 'user vhdl-electric-keywords)
- (let ((alist vhdl-model-alist)
- abbrev-list keyword)
- (while alist
- (setq keyword (nth 3 (car alist)))
+ (let (abbrev-list keyword)
+ (dolist (elem vhdl-model-alist)
+ (setq keyword (nth 3 elem))
(unless (equal keyword "")
- (setq abbrev-list
- (cons (list keyword ""
- (vhdl-function-name
- "vhdl-model" (nth 0 (car alist)) "hook") 0)
- abbrev-list)))
- (setq alist (cdr alist)))
+ (push (list keyword ""
+ (vhdl-function-name
+ "vhdl-model" (nth 0 elem) "hook") 0 'system)
+ abbrev-list)))
abbrev-list)))))
;; initialize abbrev table for VHDL Mode
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Menues
+;;; Menus
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
("Mode"
["Electric Mode"
(progn (customize-set-variable 'vhdl-electric-mode
- (not vhdl-electric-mode))
- (vhdl-mode-line-update))
+ (not vhdl-electric-mode)))
:style toggle :selected vhdl-electric-mode :keys "C-c C-m C-e"]
["Stutter Mode"
(progn (customize-set-variable 'vhdl-stutter-mode
- (not vhdl-stutter-mode))
- (vhdl-mode-line-update))
+ (not vhdl-stutter-mode)))
:style toggle :selected vhdl-stutter-mode :keys "C-c C-m C-s"]
["Indent Tabs Mode"
(progn (customize-set-variable 'vhdl-indent-tabs-mode
menu-list))
(setq comp-alist (cdr comp-alist)))
(setq menu-list (nreverse menu-list))
- (vhdl-menu-split menu-list "Compler")))
+ (vhdl-menu-split menu-list "Compiler")))
["Use Local Error Regexp"
(customize-set-variable 'vhdl-compile-use-local-error-regexp
(not vhdl-compile-use-local-error-regexp))
;; performs all buffer local initializations
;;;###autoload
-(defun vhdl-mode ()
+(define-derived-mode vhdl-mode prog-mode
+ '("VHDL" (vhdl-electric-mode "/" (vhdl-stutter-mode "/"))
+ (vhdl-electric-mode "e")
+ (vhdl-stutter-mode "s"))
"Major mode for editing VHDL code.
Usage:
CODE BEAUTIFICATION:
`C-c M-b' and `C-c C-b' beautify the code of a region or of the entire
- buffer respectively. This inludes indentation, alignment, and case
+ buffer respectively. This includes indentation, alignment, and case
fixing. Code beautification can also be run non-interactively using the
command:
PRINTING:
- Postscript printing with different faces (an optimized set of faces is
+ PostScript printing with different faces (an optimized set of faces is
used if `vhdl-print-customize-faces' is non-nil) or colors \(if
`ps-print-color-p' is non-nil) is possible using the standard Emacs
- postscript printing commands. Option `vhdl-print-two-column' defines
+ PostScript printing commands. Option `vhdl-print-two-column' defines
appropriate default settings for nice landscape two-column printing.
The paper format can be set by option `ps-paper-type'. Do not forget to
switch `ps-print-color-p' to nil for printing on black-and-white
to above mailing lists by sending an email to <reto@gnu.org>.
VHDL Mode is officially distributed at
-http://opensource.ethz.ch/emacs/vhdl-mode.html
+URL `http://opensource.ethz.ch/emacs/vhdl-mode.html'
where the latest version can be found.
-------------
\\{vhdl-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'vhdl-mode)
- (setq mode-name "VHDL")
-
- ;; set maps and tables
- (use-local-map vhdl-mode-map)
- (set-syntax-table vhdl-mode-syntax-table)
- (setq local-abbrev-table vhdl-mode-abbrev-table)
+ :abbrev-table vhdl-mode-abbrev-table
;; set local variables
(set (make-local-variable 'paragraph-start)
"\\s-*\\(--+\\s-*$\\|[^ -]\\|$\\)")
(set (make-local-variable 'paragraph-separate) paragraph-start)
(set (make-local-variable 'paragraph-ignore-fill-prefix) t)
- (set (make-local-variable 'require-final-newline)
- (if vhdl-emacs-22 mode-require-final-newline t))
(set (make-local-variable 'parse-sexp-ignore-comments) t)
(set (make-local-variable 'indent-line-function) 'vhdl-indent-line)
(set (make-local-variable 'comment-start) "--")
;; setup the comment indent variable in a Emacs version portable way
;; ignore any byte compiler warnings you might get here
(when (boundp 'comment-indent-function)
- (make-local-variable 'comment-indent-function)
- (setq comment-indent-function 'vhdl-comment-indent))
+ (set (make-local-variable 'comment-indent-function) 'vhdl-comment-indent))
;; initialize font locking
(set (make-local-variable 'font-lock-defaults)
(list
'(nil vhdl-font-lock-keywords) nil
- (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
- '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
+ (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line))
+ (if (eval-when-compile (fboundp 'syntax-propertize-rules))
+ (set (make-local-variable 'syntax-propertize-function)
+ (syntax-propertize-rules
+ ;; Mark single quotes as having string quote syntax in
+ ;; 'c' instances.
+ ("\\(\'\\).\\(\'\\)" (1 "\"'") (2 "\"'"))))
+ (set (make-local-variable 'font-lock-syntactic-keywords)
+ vhdl-font-lock-syntactic-keywords))
(unless vhdl-emacs-21
(set (make-local-variable 'font-lock-support-mode) 'lazy-lock-mode)
(set (make-local-variable 'lazy-lock-defer-contextually) nil)
;; miscellaneous
(vhdl-ps-print-init)
(vhdl-write-file-hooks-init)
- (vhdl-mode-line-update)
(message "VHDL Mode %s.%s" vhdl-version
- (if noninteractive "" " See menu for documentation and release notes."))
-
- ;; run hooks
- (if vhdl-emacs-22
- (run-mode-hooks 'vhdl-mode-hook)
- (run-hooks 'vhdl-mode-hook)))
+ (if noninteractive "" " See menu for documentation and release notes.")))
(defun vhdl-activate-customizations ()
"Activate all customizations on local variables."
(vhdl-write-file-hooks-init)
(vhdl-update-mode-menu)
(vhdl-hideshow-init)
- (run-hooks 'menu-bar-update-hook)
- (vhdl-mode-line-update))
+ (run-hooks 'menu-bar-update-hook))
(defun vhdl-write-file-hooks-init ()
"Add/remove hooks when buffer is saved."
(if vhdl-modify-date-on-saving
- (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror)
- (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror))
- (make-local-variable 'after-save-hook)
- (add-hook 'after-save-hook 'vhdl-add-modified-file))
+ (add-hook 'local-write-file-hooks 'vhdl-template-modify-noerror nil t)
+ (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror t))
+ (if (featurep 'xemacs) (make-local-hook 'after-save-hook))
+ (add-hook 'after-save-hook 'vhdl-add-modified-file nil t))
(defun vhdl-process-command-line-option (option)
"Process command line options for VHDL Mode."
(lambda (varentry)
(let ((var (car varentry))
(val (cdr varentry)))
- (and local
- (make-local-variable var))
;; special case for vhdl-offsets-alist
(if (not (eq var 'vhdl-offsets-alist))
- (set var val)
+ (set (if local (make-local-variable var) var) val)
;; reset vhdl-offsets-alist to the default value first
- (setq vhdl-offsets-alist (copy-alist vhdl-offsets-alist-default))
+ (set (if local (make-local-variable var) var)
+ (copy-alist vhdl-offsets-alist-default))
;; now set the langelems that are different
(mapcar
(function
;; Indentation commands
(defun vhdl-electric-tab (&optional prefix-arg)
- "If preceeding character is part of a word or a paren then hippie-expand,
+ "If preceding character is part of a word or a paren then hippie-expand,
else if right of non whitespace on line then insert tab,
else if last command was a tab or return then dedent one step or if a comment
toggle between normal indent and inline comment indent,
(interactive "*P")
(vhdl-prepare-search-2
(cond
+ ;; indent region if region is active
+ ((and (not (featurep 'xemacs)) (use-region-p))
+ (vhdl-indent-region (region-beginning) (region-end) nil))
;; expand word
((= (char-syntax (preceding-char)) ?w)
(let ((case-fold-search (not vhdl-word-completion-case-sensitive))
(save-excursion
(goto-char begin)
(let (element
- (eol (save-excursion (progn (end-of-line) (point)))))
+ (eol (point-at-eol)))
(setq element (nth 0 copy))
(when (and (or (and (listp (car element))
(memq major-mode (car element)))
;; Determine the greatest whitespace distance to the alignment
;; character
(goto-char begin)
- (setq eol (progn (end-of-line) (point))
+ (setq eol (point-at-eol)
bol (setq begin (progn (beginning-of-line) (point))))
(while (< bol end)
(save-excursion
(setq max distance))))
(forward-line)
(setq bol (point)
- eol (save-excursion (end-of-line) (point)))
+ eol (point-at-eol))
(setq lines (1+ lines)))
;; Now insert enough maxs to push each assignment operator to
;; the same column. We need to use 'lines' as a counter, since
;; the location of the mark may change
(goto-char (setq bol begin))
- (setq eol (save-excursion (end-of-line) (point)))
+ (setq eol (point-at-eol))
(while (> lines 0)
(when (and (re-search-forward match eol t)
(not (vhdl-in-literal)))
(beginning-of-line)
(forward-line)
(setq bol (point)
- eol (save-excursion (end-of-line) (point)))
+ eol (point-at-eol))
(setq lines (1- lines))))))
(defun vhdl-align-region-groups (beg end &optional spacing
(forward-char)
(vhdl-forward-syntactic-ws))
(goto-char end)
- (when (> pos (save-excursion (end-of-line) (point)))
+ (when (> pos (point-at-eol))
(error "ERROR: Not within a generic/port clause"))
;; delete closing parenthesis on separate line (not supported style)
(when (save-excursion (beginning-of-line) (looking-at "^\\s-*);"))
(condition-case () (forward-sexp)
(error (goto-char (point-max))))
(< (point) end))
- (delete-backward-char 1))
+ (delete-char -1))
;; add closing parenthesis
(when (> (point) end)
(goto-char end)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Enabling/disabling
-(defun vhdl-mode-line-update ()
- "Update the modeline string for VHDL major mode."
- (setq mode-name (concat "VHDL"
- (and (or vhdl-electric-mode vhdl-stutter-mode) "/")
- (and vhdl-electric-mode "e")
- (and vhdl-stutter-mode "s")))
- (force-mode-line-update t))
-
-(defun vhdl-electric-mode (arg)
+(define-minor-mode vhdl-electric-mode
"Toggle VHDL electric mode.
-Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil."
- (interactive "P")
- (setq vhdl-electric-mode
- (cond ((or (not arg) (zerop arg)) (not vhdl-electric-mode))
- ((> arg 0) t) (t nil)))
- (vhdl-mode-line-update))
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable it if ARG
+is omitted or nil."
+ :global t)
-(defun vhdl-stutter-mode (arg)
+(define-minor-mode vhdl-stutter-mode
"Toggle VHDL stuttering mode.
-Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil."
- (interactive "P")
- (setq vhdl-stutter-mode
- (cond ((or (not arg) (zerop arg)) (not vhdl-stutter-mode))
- ((> arg 0) t) (t nil)))
- (vhdl-mode-line-update))
+With a prefix argument ARG, enable the mode if ARG is positive,
+and disable it otherwise. If called from Lisp, enable it if ARG
+is omitted or nil."
+ :global t)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Stuttering
(defun vhdl-electric-quote (count) "'' --> \""
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
- (if (= (preceding-char) last-input-char)
- (progn (delete-backward-char 1) (insert-char ?\" 1))
+ (if (= (preceding-char) last-input-event)
+ (progn (delete-char -1) (insert-char ?\" 1))
(insert-char ?\' 1))
(self-insert-command count)))
(defun vhdl-electric-semicolon (count) "';;' --> ' : ', ': ;' --> ' := '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
- (cond ((= (preceding-char) last-input-char)
+ (cond ((= (preceding-char) last-input-event)
(progn (delete-char -1)
(unless (eq (preceding-char) ? ) (insert " "))
(insert ": ")
(defun vhdl-electric-comma (count) "',,' --> ' <= '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
- (cond ((= (preceding-char) last-input-char)
+ (cond ((= (preceding-char) last-input-event)
(progn (delete-char -1)
(unless (eq (preceding-char) ? ) (insert " "))
(insert "<= ")))
(defun vhdl-electric-period (count) "'..' --> ' => '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
- (cond ((= (preceding-char) last-input-char)
+ (cond ((= (preceding-char) last-input-event)
(progn (delete-char -1)
(unless (eq (preceding-char) ? ) (insert " "))
(insert "=> ")))
(defun vhdl-electric-equal (count) "'==' --> ' == '"
(interactive "p")
(if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal)))
- (cond ((= (preceding-char) last-input-char)
+ (cond ((= (preceding-char) last-input-event)
(progn (delete-char -1)
(unless (eq (preceding-char) ? ) (insert " "))
(insert "== ")))
(unless (vhdl-template-field
(concat "[type" (and (vhdl-standard-p 'ams) " or nature") "]")
nil t)
- (delete-backward-char 3))
+ (delete-char -3))
(vhdl-insert-keyword " IS ")
(vhdl-template-field "name" ";")
(vhdl-comment-insert-inline))))
(vhdl-template-field "library name" "." nil nil nil nil
(vhdl-work-library))
(vhdl-template-field "configuration name" ";"))
- (t (delete-backward-char 1) (insert ";") t))))))
+ (t (delete-char -1) (insert ";") t))))))
(defun vhdl-template-configuration-decl ()
(vhdl-insert-keyword " OPEN ")
(unless (vhdl-template-field "[READ_MODE | WRITE_MODE | APPEND_MODE]"
nil t)
- (delete-backward-char 6)))
+ (delete-char -6)))
(vhdl-insert-keyword " IS ")
(when (vhdl-standard-p '87)
(vhdl-template-field "[IN | OUT]" " " t))
(insert "\n")
(indent-to margin))
(delete-region end-pos (point))
- (delete-backward-char 1)
+ (delete-char -1)
(insert ")")
(when vhdl-auto-align (vhdl-align-region-groups start (point) 1))
t)
(vhdl-insert-keyword "REPORT ")
(if (equal "\"\"" (vhdl-template-field
"string expression" nil t start (point) t))
- (delete-backward-char 2)
+ (delete-char -2)
(setq start (point))
(vhdl-insert-keyword " SEVERITY ")
(unless (vhdl-template-field "[NOTE | WARNING | ERROR | FAILURE]" nil t)
"[scalar type | ARRAY | RECORD | ACCESS | FILE]" nil t)
""))))
(cond ((equal definition "")
- (delete-backward-char 4)
+ (delete-char -4)
(insert ";"))
((equal definition "ARRAY")
(delete-region (point) (progn (forward-word -1) (point)))
(if (not (or (and string (progn (insert string) t))
(vhdl-template-field "[comment]" nil t)))
(delete-region position (point))
- (while (= (preceding-char) ? ) (delete-backward-char 1))
-; (when (> (current-column) end-comment-column)
-; (setq position (point-marker))
-; (re-search-backward "-- ")
-; (insert "\n")
-; (indent-to comment-column)
-; (goto-char position))
+ (while (= (preceding-char) ?\ ) (delete-char -1))
+ ;; (when (> (current-column) end-comment-column)
+ ;; (setq position (point-marker))
+ ;; (re-search-backward "-- ")
+ ;; (insert "\n")
+ ;; (indent-to comment-column)
+ ;; (goto-char position))
))))
(defun vhdl-comment-block ()
(when semicolon-pos (goto-char semicolon-pos))
(if not-empty
(progn (delete-char 1) (insert ")"))
- (delete-backward-char 2))))
+ (delete-char -2))))
(defun vhdl-template-generic-list (optional &optional no-value)
"Read from user a generic spec argument list."
(if vhdl-upper-case-keywords (upcase-word num) (downcase-word num)))
(defun vhdl-minibuffer-tab (&optional prefix-arg)
- "If preceeding character is part of a word or a paren then hippie-expand,
+ "If preceding character is part of a word or a paren then hippie-expand,
else insert tab (used for word completion in VHDL minibuffer)."
(interactive "P")
(cond
(backward-word 1)
(vhdl-case-word 1)
(delete-char 1))
- (let ((invoke-char last-command-char)
+ (let ((invoke-char last-command-event)
(abbrev-mode -1)
(vhdl-template-invoked-by-hook t))
(let ((caught (catch 'abort
(defvar vhdl-port-list nil
"Variable to hold last port map parsed.")
-;; structure: (parenthesised expression means list of such entries)
+;; structure: (parenthesized expression means list of such entries)
;; (ent-name
;; ((generic-names) generic-type generic-init generic-comment group-comment)
;; ((port-names) port-object port-direct port-type port-comment group-comment)
(defvar vhdl-subprog-list nil
"Variable to hold last subprogram interface parsed.")
-;; structure: (parenthesised expression means list of such entries)
+;; structure: (parenthesized expression means list of such entries)
;; (subprog-name kind
;; ((names) object direct type init comment group-comment)
;; return-type return-comment group-comment)
"Return the line number of the line containing point."
(save-restriction
(widen)
- (save-excursion
- (beginning-of-line)
- (1+ (count-lines 1 (point))))))
+ (1+ (count-lines (point-min) (point-at-bol)))))
(defun vhdl-line-kill-entire (&optional arg)
"Delete entire line."
"Copy current line."
(interactive "p")
(save-excursion
- (beginning-of-line)
- (let ((position (point)))
+ (let ((position (point-at-bol)))
(forward-line (or arg 1))
(copy-region-as-kill position (point)))))
(cons (list 'vhdl-mode vhdl-hs-start-regexp nil "--\\( \\|$\\)"
'vhdl-hs-forward-sexp-func nil)
hs-special-modes-alist)))
- (make-local-variable 'hs-minor-mode-hook)
+ (if (featurep 'xemacs) (make-local-hook 'hs-minor-mode-hook))
(if vhdl-hide-all-init
- (add-hook 'hs-minor-mode-hook 'hs-hide-all)
- (remove-hook 'hs-minor-mode-hook 'hs-hide-all))
+ (add-hook 'hs-minor-mode-hook 'hs-hide-all nil t)
+ (remove-hook 'hs-minor-mode-hook 'hs-hide-all t))
(hs-minor-mode arg)
- (vhdl-mode-line-update))) ; hack to update menu bar
+ (force-mode-line-update))) ; hack to update menu bar
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
"Re-initialize fontification and fontify buffer."
(interactive)
(setq font-lock-defaults
- (list
- 'vhdl-font-lock-keywords nil
- (not vhdl-highlight-case-sensitive) '((?\_ . "w")) 'beginning-of-line
- '(font-lock-syntactic-keywords . vhdl-font-lock-syntactic-keywords)))
+ `(vhdl-font-lock-keywords
+ nil ,(not vhdl-highlight-case-sensitive) ((?\_ . "w"))
+ beginning-of-line))
(when (fboundp 'font-lock-unset-defaults)
(font-lock-unset-defaults)) ; not implemented in XEmacs
(font-lock-set-defaults)
(font-lock-mode t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Initialization for postscript printing
+;; Initialization for PostScript printing
(defun vhdl-ps-print-settings ()
- "Initialize custom face and page settings for postscript printing."
+ "Initialize custom face and page settings for PostScript printing."
;; define custom face settings
(unless (or (not vhdl-print-customize-faces)
ps-print-color-p)
(set (make-local-variable 'ps-right-margin) 40.0))))
(defun vhdl-ps-print-init ()
- "Initialize postscript printing."
+ "Initialize PostScript printing."
(if (featurep 'xemacs)
(when (boundp 'ps-print-color-p)
(vhdl-ps-print-settings))
- (make-local-variable 'ps-print-hook)
- (add-hook 'ps-print-hook 'vhdl-ps-print-settings)))
+ (if (featurep 'xemacs) (make-local-hook 'ps-print-hook))
+ (add-hook 'ps-print-hook 'vhdl-ps-print-settings nil t)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar vhdl-entity-alist nil
"Cache with entities and corresponding architectures for each
project/directory.")
-;; structure: (parenthesised expression means list of such entries)
+;; structure: (parenthesized expression means list of such entries)
;; (cache-key
;; (ent-key ent-name ent-file ent-line
;; (arch-key arch-name arch-file arch-line
(defvar vhdl-config-alist nil
"Cache with configurations for each project/directory.")
-;; structure: (parenthesised expression means list of such entries)
+;; structure: (parenthesized expression means list of such entries)
;; (cache-key
;; (conf-key conf-name conf-file conf-line ent-key arch-key
;; (inst-key inst-comp-name inst-ent-key inst-arch-key
(defvar vhdl-package-alist nil
"Cache with packages for each project/directory.")
-;; structure: (parenthesised expression means list of such entries)
+;; structure: (parenthesized expression means list of such entries)
;; (cache-key
;; (pack-key pack-name pack-file pack-line
;; (comp-key comp-name comp-file comp-line)
(defvar vhdl-ent-inst-alist nil
"Cache with instantiated entities for each project/directory.")
-;; structure: (parenthesised expression means list of such entries)
+;; structure: (parenthesized expression means list of such entries)
;; (cache-key (inst-ent-key))
(defvar vhdl-file-alist nil
"Cache with design units in each file for each project/directory.")
-;; structure: (parenthesised expression means list of such entries)
+;; structure: (parenthesized expression means list of such entries)
;; (cache-key
;; (file-name (ent-list) (arch-list) (arch-ent-list) (conf-list)
;; (pack-list) (pack-body-list) (inst-list) (inst-ent-list))
(defvar vhdl-directory-alist nil
"Cache with source directories for each project.")
-;; structure: (parenthesised expression means list of such entries)
+;; structure: (parenthesized expression means list of such entries)
;; (cache-key (directory))
(defvar vhdl-speedbar-shown-unit-alist nil
;; Scan functions
(defun vhdl-scan-context-clause ()
- "Scan the context clause that preceeds a design unit."
+ "Scan the context clause that precedes a design unit."
(let (lib-alist)
(save-excursion
(when (re-search-backward "^[ \t]*\\(architecture\\|configuration\\|entity\\|package\\)\\>" nil t)
(vhdl-speedbar-update-current-unit)
(when updated (message "Updating hierarchy...done")))))
-;; structure (parenthesised expression means list of such entries)
+;; structure (parenthesized expression means list of such entries)
;; (inst-key inst-file-marker comp-ent-key comp-ent-file-marker
;; comp-arch-key comp-arch-file-marker comp-conf-key comp-conf-file-marker
;; comp-lib-name level)
(let ((buffer (get-file-buffer (car token))))
(speedbar-find-file-in-frame (car token))
(when (or vhdl-speedbar-jump-to-unit buffer)
- (goto-line (cdr token))
+ (goto-char (point-min))
+ (forward-line (1- (cdr token)))
(recenter))
(vhdl-speedbar-update-current-unit t t)
(speedbar-set-timer dframe-update-speed)
(let ((token (get-text-property
(match-beginning 3) 'speedbar-token)))
(vhdl-visit-file (car token) t
- (progn (goto-line (cdr token))
+ (progn (goto-char (point-min))
+ (forward-line (1- (cdr token)))
(end-of-line)
(if is-entity
(vhdl-port-copy)
;; insert component declarations
(while ent-alist
(vhdl-visit-file (nth 2 (car ent-alist)) nil
- (progn (goto-line (nth 3 (car ent-alist)))
+ (progn (goto-char (point-min))
+ (forward-line (1- (nth 3 (car ent-alist))))
(end-of-line)
(vhdl-port-copy)))
(goto-char component-pos)
&optional insert-conf)
"Generate block configuration for architecture."
(let ((margin (current-indentation))
- (beg (save-excursion (beginning-of-line) (point)))
+ (beg (point-at-bol))
ent-entry inst-entry inst-path inst-prev-path cons-key tmp-alist)
;; insert block configuration (for architecture)
(vhdl-insert-keyword "FOR ") (insert arch-name "\n")
`vhdl-configuration-file-name': (new)
Specify how the configuration file name is obtained.
`vhdl-compose-configuration-name': (new)
- Specify how the configuration name is optained.
+ Specify how the configuration name is obtained.
`vhdl-compose-configuration-create-file': (new)
Specify whether a new file should be created for a configuration.
`vhdl-compose-configuration-hierarchical': (new)
(princ (documentation-property variable 'variable-documentation))
(with-current-buffer standard-output
(help-mode))
- (print-help-return-message)))
+ (help-print-return-message)))
(defun vhdl-doc-mode ()
"Display VHDL Mode documentation in *Help* buffer."
(princ (documentation 'vhdl-mode))
(with-current-buffer standard-output
(help-mode))
- (print-help-return-message)))
+ (help-print-return-message)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide 'vhdl-mode)
-;; arch-tag: 780d7073-9b5d-4c6c-b0d8-26b28783aba3
;;; vhdl-mode.el ends here