diff options
Diffstat (limited to 'lisp/progmodes/vhdl-mode.el')
| -rw-r--r-- | lisp/progmodes/vhdl-mode.el | 90 |
1 files changed, 43 insertions, 47 deletions
diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index 506e9a6b2c7..9eedbf9cbc9 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -126,13 +126,15 @@ ;;; Code: -(eval-when-compile (require 'cl)) -(eval-and-compile - ;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin' - ;; even for relatively simple cases such as used here. We only test <25 - ;; because it's easier and sufficient. - (when (or (featurep 'xemacs) (< emacs-major-version 25)) - (require 'cl))) +(eval-when-compile + (condition-case nil (require 'cl-lib) (file-missing (require 'cl))) + (defalias 'vhdl--pushnew (if (fboundp 'cl-pushnew) 'cl-pushnew 'pushnew))) + +;; Before Emacs-24.4, `pushnew' expands to runtime calls to `cl-adjoin' +;; even for relatively simple cases such as used here. We only test <25 +;; because it's easier and sufficient. +(when (< emacs-major-version 25) + (condition-case nil (require 'cl-lib) (file-missing (require 'cl)))) ;; Emacs 21+ handling (defconst vhdl-emacs-21 (and (<= 21 emacs-major-version) (not (featurep 'xemacs))) @@ -2474,7 +2476,7 @@ specified." (defun vhdl-resolve-env-variable (string) "Resolve environment variables in STRING." - (while (string-match "\\(.*\\)${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string) + (while (string-match "\\(.*\\)\\${?\\(\\(\\w\\|_\\)+\\)}?\\(.*\\)" string) (setq string (concat (match-string 1 string) (getenv (match-string 2 string)) (match-string 4 string)))) @@ -4953,8 +4955,8 @@ Key bindings: (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 nil t) - (remove-hook 'local-write-file-hooks 'vhdl-template-modify-noerror t)) + (add-hook 'write-file-functions 'vhdl-template-modify-noerror nil t) + (remove-hook 'write-file-functions '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)) @@ -6699,7 +6701,7 @@ search, and an argument indicating an interactive call." (if (and interactive (or (nth 3 state) (nth 4 state) - (looking-at (concat "[ \t]*" comment-start-skip)))) + (looking-at (concat "[ \t]*\\(?:" comment-start-skip "\\)")))) (forward-sentence (- count)) (while (> count 0) (vhdl-beginning-of-statement-1 lim) @@ -7392,8 +7394,8 @@ only-lines." (defun vhdl-update-progress-info (string pos) "Update progress information." (when (and vhdl-progress-info (not noninteractive) - (< vhdl-progress-interval - (- (nth 1 (current-time)) (aref vhdl-progress-info 2)))) + (time-less-p vhdl-progress-interval + (time-since (aref vhdl-progress-info 2)))) (let ((delta (- (aref vhdl-progress-info 1) (aref vhdl-progress-info 0)))) (message "%s... (%2d%%)" string @@ -7401,7 +7403,7 @@ only-lines." 100 (floor (* 100.0 (- pos (aref vhdl-progress-info 0))) delta)))) - (aset vhdl-progress-info 2 (nth 1 (current-time))))) + (aset vhdl-progress-info 2 (encode-time nil 'integer)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Indentation commands @@ -8142,12 +8144,12 @@ depending on parameter UPPER-CASE." (upcase-word -1) (downcase-word -1))) (when (and count vhdl-progress-interval (not noninteractive) - (< vhdl-progress-interval - (- (nth 1 (current-time)) last-update))) + (time-less-p vhdl-progress-interval + (time-since last-update))) (message "Fixing case... (%2d%s)" (+ (* count 20) (/ (* 20 (- (point) beg)) (- end beg))) "%") - (setq last-update (nth 1 (current-time))))) + (setq last-update (encode-time nil 'integer)))) (goto-char end))))) (defun vhdl-fix-case-region (beg end &optional arg) @@ -8707,17 +8709,11 @@ project is defined." ;; Enabling/disabling (define-minor-mode vhdl-electric-mode - "Toggle VHDL electric mode. -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." + "Toggle VHDL electric mode." :global t :group 'vhdl-mode) (define-minor-mode vhdl-stutter-mode - "Toggle VHDL stuttering mode. -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." + "Toggle VHDL stuttering mode." :global t :group 'vhdl-mode) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -14321,7 +14317,7 @@ of PROJECT." (vhdl-scan-directory-contents dir-name project nil (format "(%s/%s) " act-dir num-dir) (cdr dir-list)) - (pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal) + (vhdl--pushnew (file-name-directory dir-name) dir-list-tmp :test #'equal) (setq dir-list (cdr dir-list) act-dir (1+ act-dir))) (vhdl-aput 'vhdl-directory-alist project (list (nreverse dir-list-tmp))) @@ -15121,7 +15117,7 @@ otherwise use cached data." (defun vhdl-speedbar-expand-project (text token indent) "Expand/contract the project under the cursor." (cond - ((string-match "+" text) ; expand project + ((string-match "\\+" text) ; expand project (speedbar-change-expand-button-char ?-) (unless (member token vhdl-speedbar-shown-project-list) (setq vhdl-speedbar-shown-project-list @@ -15143,7 +15139,7 @@ otherwise use cached data." (defun vhdl-speedbar-expand-entity (text token indent) "Expand/contract the entity under the cursor." (cond - ((string-match "+" text) ; expand entity + ((string-match "\\+" text) ; expand entity (let* ((key (vhdl-speedbar-line-key indent)) (ent-alist (vhdl-aget vhdl-entity-alist key)) (ent-entry (vhdl-aget ent-alist token)) @@ -15212,7 +15208,7 @@ otherwise use cached data." (defun vhdl-speedbar-expand-architecture (text token indent) "Expand/contract the architecture under the cursor." (cond - ((string-match "+" text) ; expand architecture + ((string-match "\\+" text) ; expand architecture (let* ((key (vhdl-speedbar-line-key (1- indent))) (ent-alist (vhdl-aget vhdl-entity-alist key)) (conf-alist (vhdl-aget vhdl-config-alist key)) @@ -15272,7 +15268,7 @@ otherwise use cached data." (defun vhdl-speedbar-expand-config (text token indent) "Expand/contract the configuration under the cursor." (cond - ((string-match "+" text) ; expand configuration + ((string-match "\\+" text) ; expand configuration (let* ((key (vhdl-speedbar-line-key indent)) (conf-alist (vhdl-aget vhdl-config-alist key)) (conf-entry (vhdl-aget conf-alist token)) @@ -15330,7 +15326,7 @@ otherwise use cached data." (defun vhdl-speedbar-expand-package (text token indent) "Expand/contract the package under the cursor." (cond - ((string-match "+" text) ; expand package + ((string-match "\\+" text) ; expand package (let* ((key (vhdl-speedbar-line-key indent)) (pack-alist (vhdl-aget vhdl-package-alist key)) (pack-entry (vhdl-aget pack-alist token)) @@ -15735,7 +15731,7 @@ NO-POSITION non-nil means do not re-position cursor." (defun vhdl-speedbar-dired (text token indent) "Speedbar click handler for directory expand button in hierarchy mode." - (cond ((string-match "+" text) ; we have to expand this dir + (cond ((string-match "\\+" text) ; we have to expand this dir (setq speedbar-shown-directories (cons (expand-file-name (concat (speedbar-line-directory indent) token "/")) @@ -16413,8 +16409,8 @@ component instantiation." (if (or (member constant-name single-list) (member constant-name multi-list)) (progn (setq single-list (delete constant-name single-list)) - (pushnew constant-name multi-list :test #'equal)) - (pushnew constant-name single-list :test #'equal)) + (vhdl--pushnew constant-name multi-list :test #'equal)) + (vhdl--pushnew constant-name single-list :test #'equal)) (unless (match-string 1) (setq generic-alist (cdr generic-alist))) (vhdl-forward-syntactic-ws)) @@ -16440,12 +16436,12 @@ component instantiation." (member signal-name multi-out-list)) (setq single-out-list (delete signal-name single-out-list)) (setq multi-out-list (delete signal-name multi-out-list)) - (pushnew signal-name local-list :test #'equal)) + (vhdl--pushnew signal-name local-list :test #'equal)) ((member signal-name single-in-list) (setq single-in-list (delete signal-name single-in-list)) - (pushnew signal-name multi-in-list :test #'equal)) + (vhdl--pushnew signal-name multi-in-list :test #'equal)) ((not (member signal-name multi-in-list)) - (pushnew signal-name single-in-list :test #'equal))) + (vhdl--pushnew signal-name single-in-list :test #'equal))) ;; output signal (cond ((member signal-name local-list) @@ -16454,12 +16450,12 @@ component instantiation." (member signal-name multi-in-list)) (setq single-in-list (delete signal-name single-in-list)) (setq multi-in-list (delete signal-name multi-in-list)) - (pushnew signal-name local-list :test #'equal)) + (vhdl--pushnew signal-name local-list :test #'equal)) ((member signal-name single-out-list) (setq single-out-list (delete signal-name single-out-list)) - (pushnew signal-name multi-out-list :test #'equal)) + (vhdl--pushnew signal-name multi-out-list :test #'equal)) ((not (member signal-name multi-out-list)) - (pushnew signal-name single-out-list :test #'equal)))) + (vhdl--pushnew signal-name single-out-list :test #'equal)))) (unless (match-string 1) (setq port-alist (cdr port-alist))) (vhdl-forward-syntactic-ws)) @@ -16542,14 +16538,14 @@ component instantiation." generic-end-pos (vhdl-compose-insert-generic constant-entry))) (setq generic-pos (point-marker)) - (pushnew constant-name written-list :test #'equal)) + (vhdl--pushnew constant-name written-list :test #'equal)) (t (vhdl-goto-marker (vhdl-max-marker generic-inst-pos generic-pos)) (setq generic-end-pos (vhdl-compose-insert-generic constant-entry)) (setq generic-inst-pos (point-marker)) - (pushnew constant-name written-list :test #'equal)))) + (vhdl--pushnew constant-name written-list :test #'equal)))) (setq constant-alist (cdr constant-alist))) (when (/= constant-temp-pos generic-inst-pos) (vhdl-goto-marker (vhdl-max-marker constant-temp-pos generic-pos)) @@ -16568,14 +16564,14 @@ component instantiation." (vhdl-max-marker port-end-pos (vhdl-compose-insert-port signal-entry))) (setq port-in-pos (point-marker)) - (pushnew signal-name written-list :test #'equal)) + (vhdl--pushnew signal-name written-list :test #'equal)) ((member signal-name multi-out-list) (vhdl-goto-marker (vhdl-max-marker port-out-pos port-in-pos)) (setq port-end-pos (vhdl-max-marker port-end-pos (vhdl-compose-insert-port signal-entry))) (setq port-out-pos (point-marker)) - (pushnew signal-name written-list :test #'equal)) + (vhdl--pushnew signal-name written-list :test #'equal)) ((or (member signal-name single-in-list) (member signal-name single-out-list)) (vhdl-goto-marker @@ -16584,12 +16580,12 @@ component instantiation." (vhdl-max-marker port-out-pos port-in-pos))) (setq port-end-pos (vhdl-compose-insert-port signal-entry)) (setq port-inst-pos (point-marker)) - (pushnew signal-name written-list :test #'equal)) + (vhdl--pushnew signal-name written-list :test #'equal)) ((equal (upcase (nth 2 signal-entry)) "OUT") (vhdl-goto-marker signal-pos) (vhdl-compose-insert-signal signal-entry) (setq signal-pos (point-marker)) - (pushnew signal-name written-list :test #'equal))) + (vhdl--pushnew signal-name written-list :test #'equal))) (setq signal-alist (cdr signal-alist))) (when (/= port-temp-pos port-inst-pos) (vhdl-goto-marker @@ -16940,7 +16936,7 @@ no project is defined." "Remove duplicate elements from IN-LIST." (let (out-list) (while in-list - (pushnew (car in-list) out-list :test #'equal) + (vhdl--pushnew (car in-list) out-list :test #'equal) (setq in-list (cdr in-list))) out-list)) |