X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/b1fc2b501450661ba452bea0df677a08cf00368b..5df4f04cd32af723742c81095b38ae83b3c2b462:/lisp/progmodes/vhdl-mode.el diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 2ff6f8f131..7ca8a7589c 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -1,7 +1,7 @@ ;;; 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 +;; 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011 ;; Free Software Foundation, Inc. ;; Authors: Reto Zimmermann @@ -933,7 +933,7 @@ if the header needs to be version controlled. The following keywords for template generation are supported: : replaced by the name of the buffer : 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') : replaced by user login name (`user-login-name') : replaced by contents of option `vhdl-company-name' : replaced by the current date @@ -2328,42 +2328,19 @@ current buffer if no project is defined." "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 @@ -2379,14 +2356,16 @@ old environment. Used for consistent searching." (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." @@ -2898,149 +2877,148 @@ STRING are replaced by `-' and substrings are converted to lower case." (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 @@ -4670,7 +4648,7 @@ releases. You are kindly invited to participate in beta testing. Subscribe to above mailing lists by sending an email to . 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. @@ -7004,6 +6982,9 @@ else indent `correctly'." (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)) @@ -8155,7 +8136,7 @@ Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil." (defun vhdl-electric-quote (count) "'' --> \"" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (if (= (preceding-char) last-input-char) + (if (= (preceding-char) last-input-event) (progn (delete-backward-char 1) (insert-char ?\" 1)) (insert-char ?\' 1)) (self-insert-command count))) @@ -8163,7 +8144,7 @@ Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil." (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 ": ") @@ -8177,7 +8158,7 @@ Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil." (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 "<= "))) @@ -8187,7 +8168,7 @@ Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil." (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 "=> "))) @@ -8197,7 +8178,7 @@ Turn on if ARG positive, turn off if ARG negative, toggle if ARG zero or nil." (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 "== "))) @@ -10609,7 +10590,7 @@ but not if inside a comment or quote." (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 @@ -12161,7 +12142,7 @@ options vhdl-upper-case-{keywords,types,attributes,enum-values}." (widen) (save-excursion (beginning-of-line) - (1+ (count-lines 1 (point)))))) + (1+ (count-lines (point-min) (point)))))) (defun vhdl-line-kill-entire (&optional arg) "Delete entire line." @@ -15171,7 +15152,8 @@ is already shown in a buffer." (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) @@ -15189,7 +15171,8 @@ is already shown in a buffer." (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) @@ -15938,7 +15921,8 @@ current project/directory." ;; 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) @@ -16998,7 +16982,7 @@ to visually support naming conventions.") (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." @@ -17012,7 +16996,7 @@ to visually support naming conventions.") (princ (documentation 'vhdl-mode)) (with-current-buffer standard-output (help-mode)) - (print-help-return-message))) + (help-print-return-message))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;