X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/0c2da6600ad7913bfc0a329a3e13016dcd7360fa..af721abd3ad489f98cc8f67ba15d4dc44d187a5d:/packages/ada-mode/ada-mode.el diff --git a/packages/ada-mode/ada-mode.el b/packages/ada-mode/ada-mode.el index c67a3eac5..9e0bdfcc6 100644 --- a/packages/ada-mode/ada-mode.el +++ b/packages/ada-mode/ada-mode.el @@ -1,13 +1,13 @@ -;;; ada-mode.el --- major-mode for editing Ada sources +;;; ada-mode.el --- major-mode for editing Ada sources -*- lexical-binding:t -*- ;; -;;; Copyright (C) 1994, 1995, 1997 - 2014 Free Software Foundation, Inc. +;; Copyright (C) 1994, 1995, 1997 - 2015 Free Software Foundation, Inc. ;; ;; Author: Stephen Leake ;; Maintainer: Stephen Leake ;; Keywords: languages ;; ada -;; Version: 5.1.7 -;; package-requires: ((wisi "1.1.0") (cl-lib "0.4") (emacs "24.2")) +;; Version: 5.1.8 +;; package-requires: ((wisi "1.1.1") (cl-lib "0.4") (emacs "24.2")) ;; url: http://stephe-leake.org/emacs/ada-mode/emacs-ada-mode.html ;; ;; (Gnu ELPA requires single digits between dots in versions) @@ -168,10 +168,10 @@ (defun ada-mode-version () "Return Ada mode version." (interactive) - (let ((version-string "5.1.7")) + (let ((version-string "5.1.8")) ;; must match: ;; ada-mode.texi - ;; README + ;; README-ada-mode ;; Version: above (if (called-interactively-p 'interactive) (message version-string) @@ -196,8 +196,7 @@ Non-nil means automatically change case of preceding word while typing. Casing of Ada keywords is done according to `ada-case-keyword', identifiers are Mixed_Case." :type 'boolean - :group 'ada - :safe 'booleanp) + :safe #'booleanp) (make-variable-buffer-local 'ada-auto-case) (defcustom ada-case-exception-file nil @@ -215,8 +214,8 @@ character, and end either at the end of the word or at a _ character. Characters after the first word are ignored, and not preserved when the list is written back to the file." :type '(repeat (file)) - :group 'ada - :safe 'listp) + ;; :safe #'listp ;FIXME: is '("~/.emacs" "~/.bashrc" "/etc/passwd") safe? + ) (defcustom ada-case-keyword 'downcase-word "Buffer-local value that may override project variable `case_keyword'. @@ -224,19 +223,27 @@ Global value is default for project variable `case_keyword'. Function to call to adjust the case of Ada keywords." :type '(choice (const downcase-word) (const upcase-word)) - :group 'ada - :safe 'functionp) + ;; :safe #'functionp ; FIXME: `functionp' CANNOT be safe! + ) (make-variable-buffer-local 'ada-case-keyword) (defcustom ada-case-identifier 'ada-mixed-case "Buffer-local value that may override project variable `case_keyword'. Global value is default for project variable `case_keyword'. -Function to call to adjust the case of Ada keywords." +Function to call to adjust the case of Ada keywords. +Called with three args; +start - buffer pos of start of identifier +end - end of identifier +force-case - if t, treat `ada-strict-case' as t" :type '(choice (const ada-mixed-case) - (const downcase-region) - (const upcase-region)) - :group 'ada - :safe 'functionp) + (const ada-lower-case) + (const ada-upper-case)) + ;; :safe #'functionp ; FIXME: `functionp' CANNOT be safe! + ) +;; we'd like to check that there are 3 args, since the previous +;; release required 2 here. But there doesn't seem to be a way to +;; access the arg count, which is only available for byte-compiled +;; functions (make-variable-buffer-local 'ada-case-identifier) (defcustom ada-case-strict t @@ -245,8 +252,7 @@ Global value is default for project variable `case_strict'. If non-nil, force Mixed_Case for identifiers. Otherwise, allow UPPERCASE for identifiers." :type 'boolean - :group 'ada - :safe 'booleanp) + :safe #'booleanp) (make-variable-buffer-local 'ada-case-strict) (defcustom ada-language-version 'ada2012 @@ -257,36 +263,29 @@ indentation parser accepts." (const ada95) (const ada2005) (const ada2012)) - :group 'ada - :safe 'symbolp) + :safe #'symbolp) (make-variable-buffer-local 'ada-language-version) (defcustom ada-fill-comment-prefix "-- " "Comment fill prefix." - :type 'string - :group 'ada) -(make-variable-buffer-local 'ada-language-version) + :type 'string) (defcustom ada-fill-comment-postfix " --" "Comment fill postfix." - :type 'string - :group 'ada) -(make-variable-buffer-local 'ada-language-version) + :type 'string) (defcustom ada-prj-file-extensions '("adp" "prj") "List of Emacs Ada mode project file extensions. Used when searching for a project file. Any file with one of these extensions will be parsed by `ada-prj-parse-file-1'." - :type 'list - :group 'ada) + :type 'list) (defcustom ada-prj-file-ext-extra nil "List of secondary project file extensions. Used when searching for a project file that can be a primary or secondary project file (referenced from a primary). The user must provide a parser for a file with one of these extensions." - :type 'list - :group 'ada) + :type 'list) ;;;;; end of user variables @@ -393,6 +392,7 @@ Values defined by cross reference packages.") ("Navigate" ["Other file" ada-find-other-file t] ["Other file don't find decl" ada-find-other-file-noset t] + ["Find file in project" ada-find-file t] ["Goto declaration/body" ada-goto-declaration t] ["Goto next statement keyword" ada-next-statement-keyword t] ["Goto declaration start" ada-goto-declaration-start t] @@ -459,7 +459,7 @@ Values defined by cross reference packages.") ["Other File" ada-find-other-file t] ["Other file don't find decl" ada-find-other-file-noset t])) -(defun ada-popup-menu (position) +(defun ada-popup-menu (_position) "Pops up a `ada-context-menu', with `ada-context-menu-on-identifer' set appropriately. POSITION is the location the mouse was clicked on. Sets `ada-context-menu-last-point' to the current position before @@ -591,7 +591,7 @@ Placeholders are defined by the skeleton backend." "return\\|" "type\\|" "when" - "\\)\\>\\)")) + "\\)\\>[^_]\\)")) ;; in case "_" has punctuation syntax "See the variable `align-region-separate' for more information.") (defun ada-align () @@ -985,6 +985,8 @@ replacing current values of `ada-case-full-exceptions', `ada-case-partial-except (push (cons word t) exceptions)) exceptions) +(defvar ada-prj-current-file) + (defun ada-case-create-exception (&optional word file-name partial) "Define WORD as an exception for the casing system, save it in FILE-NAME. If PARTIAL is non-nil, create a partial word exception. WORD @@ -1025,12 +1027,13 @@ list." (if (use-region-p) (setq word (buffer-substring-no-properties (region-beginning) (region-end))) (save-excursion - (skip-syntax-backward "w_") - (setq word - (buffer-substring-no-properties - (point) - (progn (skip-syntax-forward "w_") (point)) - ))))) + (let ((syntax (if partial "w" "w_"))) + (skip-syntax-backward syntax) + (setq word + (buffer-substring-no-properties + (point) + (progn (skip-syntax-forward syntax) (point)) + )))))) (let* ((exceptions (ada-case-read-exceptions file-name)) (full-exceptions (car exceptions)) @@ -1061,7 +1064,7 @@ User is prompted to choose a file from project variable casing if it is a list." (defun ada-in-numeric-literal-p () "Return t if point is after a prefix of a numeric literal." ;; FIXME: this is actually a based numeric literal; excludes 1234 - (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)")) + (looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)" (line-beginning-position))) (defvar ada-keywords nil "List of Ada keywords for current `ada-language-version'.") @@ -1073,11 +1076,17 @@ User is prompted to choose a file from project variable casing if it is a list." (point)))) (member (downcase word) ada-keywords))) -(defun ada-mixed-case (start end) +(defun ada-lower-case (start end _force-case-strict) + (downcase-region start end)) + +(defun ada-upper-case (start end _force-case-strict) + (upcase-region start end)) + +(defun ada-mixed-case (start end force-case-strict) "Adjust case of region START END to Mixed_Case." (let ((done nil) next) - (if ada-case-strict + (if (or force-case-strict ada-case-strict) (downcase-region start end)) (goto-char start) (while (not done) @@ -1095,7 +1104,7 @@ User is prompted to choose a file from project variable casing if it is a list." (setq done t)) ))) -(defun ada-case-adjust-identifier () +(defun ada-case-adjust-identifier (&optional force-case) "Adjust case of the previous word as an identifier. Uses `ada-case-identifier', with exceptions defined in `ada-case-full-exceptions', `ada-case-partial-exceptions'." @@ -1118,7 +1127,7 @@ Uses `ada-case-identifier', with exceptions defined in (delete-region (point) end)) ;; else apply ada-case-identifier - (funcall ada-case-identifier start end) + (funcall ada-case-identifier start end force-case) ;; apply partial-exceptions (goto-char start) @@ -1145,7 +1154,8 @@ Uses `ada-case-identifier', with exceptions defined in "Adjust the case of the word before point. When invoked interactively, TYPED-CHAR must be `last-command-event', and it must not have been inserted yet. -If IN-COMMENT is non-nil, adjust case of words in comments and strings as code." +If IN-COMMENT is non-nil, adjust case of words in comments and strings as code, +and treat `ada-case-strict' as t in code.." (when (not (bobp)) (when (save-excursion (forward-char -1); back to last character in word @@ -1177,7 +1187,7 @@ If IN-COMMENT is non-nil, adjust case of words in comments and strings as code." (save-excursion (skip-syntax-backward "w_") (eq (char-before) ?'))) - (ada-case-adjust-identifier)) + (ada-case-adjust-identifier in-comment)) ((and (not in-comment) @@ -1185,7 +1195,7 @@ If IN-COMMENT is non-nil, adjust case of words in comments and strings as code." (ada-after-keyword-p)) (funcall ada-case-keyword -1)) - (t (ada-case-adjust-identifier)) + (t (ada-case-adjust-identifier in-comment)) )) ))) @@ -1980,7 +1990,7 @@ don't move to corresponding declaration." (interactive "P") (ada-find-other-file other-window t)) -(defun ada-find-other-file (other-window &optional no-set-point) +(defun ada-find-other-file (other-window &optional _no-set-point) "Move to the corresponding declaration in another file. - If region is active, assume it contains a package name; @@ -2059,37 +2069,36 @@ identifier. May be an Ada identifier or operator." (when (ada-in-comment-p) (error "Inside comment")) - (let (identifier) - - (skip-chars-backward "a-zA-Z0-9_<>=+\\-\\*/&") + (skip-chars-backward "a-zA-Z0-9_<>=+\\-\\*/&") - ;; Just in front of, or inside, a string => we could have an - ;; operator function declaration. + ;; Just in front of, or inside, a string => we could have an + ;; operator function declaration. + (cond + ((ada-in-string-p) (cond - ((ada-in-string-p) - (cond - ((and (= (char-before) ?\") - (progn - (forward-char -1) - (looking-at (concat "\"\\(" ada-operator-re "\\)\"")))) - (setq identifier (concat "\"" (match-string-no-properties 1) "\""))) + ((and (= (char-before) ?\") + (progn + (forward-char -1) + (looking-at (concat "\"\\(" ada-operator-re "\\)\"")))) + (concat "\"" (match-string-no-properties 1) "\"")) - (t - (error "Inside string or character constant")) - )) + (t + (error "Inside string or character constant")) + )) - ((and (= (char-after) ?\") - (looking-at (concat "\"\\(" ada-operator-re "\\)\""))) - (setq identifier (concat "\"" (match-string-no-properties 1) "\""))) + ((and (= (char-after) ?\") + (looking-at (concat "\"\\(" ada-operator-re "\\)\""))) + (concat "\"" (match-string-no-properties 1) "\"")) - ((looking-at "[a-zA-Z0-9_]+\\|[+\\-*/&=<>]") - (setq identifier (match-string-no-properties 0))) + ((looking-at "[a-zA-Z0-9_]+\\|[+\\-*/&=<>]") + (match-string-no-properties 0)) - (t - (error "No identifier around")) - ))) + (t + (error "No identifier around")) + )) +;; FIXME: use find-tag-marker-ring, ring-insert, pop-tag-mark (see xref.el) (defvar ada-goto-pos-ring '() "List of positions selected by navigation functions. Used to go back to these positions.") @@ -2800,8 +2809,8 @@ The paragraph is indented on the first line." (unless (featurep 'ada-xref-tool) (cl-case ada-xref-tool - ((nil 'gnat) (require 'ada-gnat-xref)) - ('gpr_query (require 'gpr-query)) + ((nil gnat) (require 'ada-gnat-xref)) + (gpr_query (require 'gpr-query)) )) (unless (featurep 'ada-compiler)