X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4c14013dbec3a2f130a38e61e885f1e8cc6c325b..6080e055498c19ebd34495f204a8ad676eb09260:/lisp/progmodes/ada-mode.el diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el index 4bbe1e43f8..17ff4bd32a 100644 --- a/lisp/progmodes/ada-mode.el +++ b/lisp/progmodes/ada-mode.el @@ -1,7 +1,6 @@ ;;; ada-mode.el --- major-mode for editing Ada sources -;; Copyright (C) 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. +;; Copyright (C) 1994-1995, 1997-2011 Free Software Foundation, Inc. ;; Author: Rolf Ebert ;; Markus Heritsch @@ -106,8 +105,8 @@ ;; should be loaded before the ada-mode, which will then setup some variables ;; to improve the support for Ada code. ;; Here is the list of these modes: -;; `which-function-mode': Display the name of the subprogram the cursor is -;; in in the mode line. +;; `which-function-mode': Display in the modeline the name of the subprogram +;; the cursor is in. ;; `outline-mode': Provides the capability to collapse or expand the code ;; for specific language constructs, for instance if you want to hide the ;; code corresponding to a subprogram @@ -460,6 +459,7 @@ The extensions should include a `.' if needed.") (defvar ada-mode-abbrev-table nil "Local abbrev table for Ada mode.") +(define-abbrev-table 'ada-mode-abbrev-table ()) (defvar ada-mode-syntax-table nil "Syntax table to be used for editing Ada source code.") @@ -499,7 +499,7 @@ Used to define `ada-*-keywords.'")) (defvar ada-case-exception-substring '() "Alist of substrings (entities) that have special casing. -The substrings are detected for word constituant when the word +The substrings are detected for word constituent when the word is not itself in `ada-case-exception', and only for substrings that either are at the beginning or end of the word, or start after '_'.") @@ -826,7 +826,7 @@ the 4 file locations can be clicked on and jumped to." ;; to be considered as part of a word or not. ;; Some characters may have multiple meanings depending on the context: ;; - ' is either the beginning of a constant character or an attribute -;; - # is either part of a based litteral or a gnatprep statement. +;; - # is either part of a based literal or a gnatprep statement. ;; - " starts a string, but not if inside a constant character. ;; - ( and ) should be ignored if inside a constant character. ;; Thus their syntax property is changed automatically, and we can still use @@ -966,7 +966,7 @@ are treated as numbers instead of gnatprep comments." (unless modified (restore-buffer-modified-p nil)))) -(defun ada-after-change-function (beg end old-len) +(defun ada-after-change-function (beg end _old-len) "Called when the region between BEG and END was changed in the buffer. OLD-LEN indicates what the length of the replaced text was." (save-excursion @@ -1117,21 +1117,13 @@ the file name." (funcall (symbol-function 'speedbar-add-supported-extension) spec) (funcall (symbol-function 'speedbar-add-supported-extension) - body))) - ) + body)))) +(defvar ada-font-lock-syntactic-keywords) ; defined below ;;;###autoload -(defun ada-mode () - "Ada mode is the major mode for editing Ada code. -\\{ada-mode-map}" - - (interactive) - (kill-all-local-variables) - - (set-syntax-table ada-mode-syntax-table) - - (set (make-local-variable 'require-final-newline) mode-require-final-newline) +(define-derived-mode ada-mode prog-mode "Ada" + "Ada mode is the major mode for editing Ada code." ;; Set the paragraph delimiters so that one can select a whole block ;; simply with M-h @@ -1302,64 +1294,54 @@ the file name." (define-key ada-mode-map ada-popup-key 'ada-popup-menu)) ;; Support for Abbreviations (the user still need to "M-x abbrev-mode" - (define-abbrev-table 'ada-mode-abbrev-table ()) (setq local-abbrev-table ada-mode-abbrev-table) ;; Support for which-function mode - (make-local-variable 'which-func-functions) - (setq which-func-functions '(ada-which-function)) + (set (make-local-variable 'which-func-functions) '(ada-which-function)) ;; Support for indent-new-comment-line (Especially for XEmacs) (set (make-local-variable 'comment-multi-line) nil) ;; Support for add-log - (set (make-local-variable 'add-log-current-defun-function) 'ada-which-function) - - (setq major-mode 'ada-mode - mode-name "Ada") - - (use-local-map ada-mode-map) + (set (make-local-variable 'add-log-current-defun-function) + 'ada-which-function) (easy-menu-add ada-mode-menu ada-mode-map) - (set-syntax-table ada-mode-syntax-table) - (set (make-local-variable 'skeleton-further-elements) '((< '(backward-delete-char-untabify (min ada-indent (current-column)))))) (add-hook 'skeleton-end-hook 'ada-adjust-case-skeleton nil t) - (run-mode-hooks 'ada-mode-hook) - ;; To be run after the hook, in case the user modified ;; ada-fill-comment-prefix - ;; FIXME: if the user modified ada-fill-comment-prefix in his .emacs - ;; then it was already available before running the hook, and if he - ;; modifies it in the hook, he might as well modify comment-start instead. - (set (make-local-variable 'comment-start) (or ada-fill-comment-prefix "-- ")) - - ;; Run this after the hook to give the users a chance to activate - ;; font-lock-mode - - (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) - (featurep 'xemacs)) - (ada-initialize-syntax-table-properties) - (add-hook 'font-lock-mode-hook 'ada-handle-syntax-table-properties nil t)) - - ;; the following has to be done after running the ada-mode-hook - ;; because users might want to set the values of these variable - ;; inside the hook - ;; FIXME: it might even be set later on via file-local vars, no? - ;; so maybe ada-keywords should be set lazily. - (cond ((eq ada-language-version 'ada83) - (setq ada-keywords ada-83-keywords)) - ((eq ada-language-version 'ada95) - (setq ada-keywords ada-95-keywords)) - ((eq ada-language-version 'ada2005) - (setq ada-keywords ada-2005-keywords))) - - (if ada-auto-case - (ada-activate-keys-for-case))) + (add-hook 'hack-local-variables-hook + (lambda () + (set (make-local-variable 'comment-start) + (or ada-fill-comment-prefix "-- ")) + + ;; Run this after the hook to give the users a chance + ;; to activate font-lock-mode. + + (unless (or (eval-when-compile (fboundp 'syntax-propertize-via-font-lock)) + (featurep 'xemacs)) + (ada-initialize-syntax-table-properties) + (add-hook 'font-lock-mode-hook + 'ada-handle-syntax-table-properties nil t)) + + ;; FIXME: ada-language-version might be set in the mode + ;; hook or it might even be set later on via file-local + ;; vars, so ada-keywords should be set lazily. + (cond ((eq ada-language-version 'ada83) + (setq ada-keywords ada-83-keywords)) + ((eq ada-language-version 'ada95) + (setq ada-keywords ada-95-keywords)) + ((eq ada-language-version 'ada2005) + (setq ada-keywords ada-2005-keywords))) + + (if ada-auto-case + (ada-activate-keys-for-case))) + nil 'local)) (defun ada-adjust-case-skeleton () "Adjust the case of the text inserted by a skeleton." @@ -1693,7 +1675,7 @@ ARG is the prefix the user entered with \\[universal-argument]." '( ?` ?_ ?# ?% ?& ?* ?( ?) ?- ?= ?+ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))) -(defun ada-loose-case-word (&optional arg) +(defun ada-loose-case-word (&optional _arg) "Upcase first letter and letters following `_' in the following word. No other letter is modified. ARG is ignored, and is there for compatibility with `capitalize-word' only." @@ -1709,16 +1691,16 @@ ARG is ignored, and is there for compatibility with `capitalize-word' only." (insert-char (upcase (following-char)) 1) (delete-char 1))))) -(defun ada-no-auto-case (&optional arg) +(defun ada-no-auto-case (&optional _arg) "Do nothing. ARG is ignored. This function can be used for the auto-casing variables in Ada mode, to -adapt to unusal auto-casing schemes. Since it does nothing, you can for +adapt to unusual auto-casing schemes. Since it does nothing, you can for instance use it for `ada-case-identifier' if you don't want any special auto-casing for identifiers, whereas keywords have to be lower-cased. See also `ada-auto-case' to disable auto casing altogether." nil) -(defun ada-capitalize-word (&optional arg) +(defun ada-capitalize-word (&optional _arg) "Upcase first letter and letters following '_', lower case other letters. ARG is ignored, and is there for compatibility with `capitalize-word' only." (interactive) @@ -1791,7 +1773,7 @@ ATTENTION: This function might take very long for big buffers!" ;; `ada-insert-paramlist'. ;; Both steps are called from `ada-format-paramlist'. ;; Note: Comments inside the parameter list are lost. -;; The syntax has to be correct, or the reformating will fail. +;; The syntax has to be correct, or the reformatting will fail. ;;-------------------------------------------------------------- (defun ada-format-paramlist () @@ -2157,7 +2139,7 @@ command like: (while command-line-args-left (let ((source (car command-line-args-left))) - (message "Formating %s" source) + (message "Formatting %s" source) (find-file source) (ada-indent-region (point-min) (point-max)) (ada-adjust-case-buffer) @@ -2471,8 +2453,7 @@ and the offset." (if (and ada-indent-is-separate (save-excursion (goto-char (match-end 0)) - (ada-goto-next-non-ws (save-excursion (end-of-line) - (point))) + (ada-goto-next-non-ws (point-at-eol)) (looking-at "\\\\|\\"))) (save-excursion (ada-goto-stmt-start) @@ -2579,10 +2560,7 @@ and the offset." (forward-line -1) (beginning-of-line) (while (and (not pos) - (search-forward "--" - (save-excursion - (end-of-line) (point)) - t)) + (search-forward "--" (point-at-eol) t)) (unless (ada-in-string-p) (setq pos (point)))) pos)) @@ -2601,7 +2579,7 @@ and the offset." ((and (= (char-after) ?#) (equal ada-which-compiler 'gnat) (looking-at "#[ \t]*\\(if\\|els\\(e\\|if\\)\\|end[ \t]*if\\)")) - (list (save-excursion (beginning-of-line) (point)) 0)) + (list (point-at-bol) 0)) ;;-------------------------------- ;; starting with ')' (end of a parameter list) @@ -3961,7 +3939,7 @@ If NOERROR is non-nil, it only returns nil if no matching start found." ;; processing them recursively avoids the need for any special ;; handling. ;; Nothing should be done if we have only the specs or a - ;; generic instantion. + ;; generic instantiation. ((and (looking-at "\\")) (if first @@ -4048,11 +4026,7 @@ Point is moved at the beginning of the SEARCH-RE." (funcall search-func search-re limit 1)) (setq begin (match-beginning 0)) (setq end (match-end 0)) - - (setq parse-result (parse-partial-sexp - (save-excursion (beginning-of-line) (point)) - (point))) - + (setq parse-result (parse-partial-sexp (point-at-bol) (point))) (cond ;; ;; If inside a string, skip it (and the following comments) @@ -4245,7 +4219,7 @@ of the region. Otherwise, operate only on the current line." ((eq ada-tab-policy 'always-tab) (error "Not implemented")) )) -(defun ada-untab (arg) +(defun ada-untab (_arg) "Delete leading indenting according to `ada-tab-policy'." ;; FIXME: ARG is ignored (interactive "P") @@ -4271,16 +4245,12 @@ of the region. Otherwise, operate only on the current line." (save-excursion (beginning-of-line) (insert-char ? ada-indent)) - (if (save-excursion (= (point) (progn (beginning-of-line) (point)))) - (forward-char ada-indent))) + (if (bolp) (forward-char ada-indent))) (defun ada-untab-hard () "Indent current line to previous tab stop." (interactive) - (let ((bol (save-excursion (progn (beginning-of-line) (point)))) - (eol (save-excursion (progn (end-of-line) (point))))) - (indent-rigidly bol eol (- 0 ada-indent)))) - + (indent-rigidly (point-at-bol) (point-at-eol) (- 0 ada-indent))) ;; ------------------------------------------------------------ @@ -4431,7 +4401,7 @@ Moves to 'begin' if in a declarative part." (ada-goto-matching-end 1)) ;; on first line of subprogram body - ;; Do nothing for specs or generic instantion, since these are + ;; Do nothing for specs or generic instantiation, since these are ;; handled as the general case (find the enclosing block) ;; We also need to make sure that we ignore nested subprograms ((save-excursion @@ -4643,7 +4613,7 @@ Moves to 'begin' if in a declarative part." ["Gdb Documentation" (info "gdb") (eq ada-which-compiler 'gnat)] ["Ada95 Reference Manual" (info "arm95") t]) - ("Options" :included (eq major-mode 'ada-mode) + ("Options" :included (derived-mode-p 'ada-mode) ["Auto Casing" (setq ada-auto-case (not ada-auto-case)) :style toggle :selected ada-auto-case] ["Auto Indent After Return" @@ -4680,7 +4650,7 @@ Moves to 'begin' if in a declarative part." ["Load..." ada-set-default-project-file t] ["New..." ada-prj-new t] ["Edit..." ada-prj-edit t]) - ("Goto" :included (eq major-mode 'ada-mode) + ("Goto" :included (derived-mode-p 'ada-mode) ["Goto Declaration/Body" ada-goto-declaration (eq ada-which-compiler 'gnat)] ["Goto Body" ada-goto-body @@ -4709,7 +4679,7 @@ Moves to 'begin' if in a declarative part." ["-" nil nil] ["Other File" ff-find-other-file t] ["Other File Other Window" ada-ff-other-window t]) - ("Edit" :included (eq major-mode 'ada-mode) + ("Edit" :included (derived-mode-p 'ada-mode) ["Search File On Source Path" ada-find-file t] ["------" nil nil] ["Complete Identifier" ada-complete-identifier t] @@ -4741,7 +4711,7 @@ Moves to 'begin' if in a declarative part." ["-----" nil nil] ["Narrow to subprogram" ada-narrow-to-defun t]) ("Templates" - :included (eq major-mode 'ada-mode) + :included (derived-mode-p 'ada-mode) ["Header" ada-header t] ["-" nil nil] ["Package Body" ada-package-body t] @@ -5280,7 +5250,7 @@ Return nil if no body was found." ;; Support for narrow-to-region ;; --------------------------------------------------------- -(defun ada-narrow-to-defun (&optional arg) +(defun ada-narrow-to-defun (&optional _arg) "Make text outside current subprogram invisible. The subprogram visible is the one that contains or follow point. Optional ARG is ignored. @@ -5292,11 +5262,7 @@ Use \\[widen] to go back to the full visibility for the buffer." (widen) (forward-line 1) (ada-previous-procedure) - - (save-excursion - (beginning-of-line) - (setq end (point))) - + (setq end (point-at-bol)) (ada-move-to-end) (end-of-line) (narrow-to-region end (point)) @@ -5538,5 +5504,4 @@ This function typically is to be hooked into `ff-file-created-hook'." ;;; provide ourselves (provide 'ada-mode) -;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270 ;;; ada-mode.el ends here