;;; 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 <ebert@inf.enst.fr>
;; Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
;; 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
(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.")
(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 '_'.")
;; 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
(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
(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
(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."
'( ?` ?_ ?# ?% ?& ?* ?( ?) ?- ?= ?+
?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\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."
(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)
;; `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 ()
(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)
(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 "\\<abstract\\>\\|\\<separate\\>")))
(save-excursion
(ada-goto-stmt-start)
(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))
((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)
;; 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 "\\<procedure\\|function\\>"))
(if first
(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)
((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")
(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)))
\f
;; ------------------------------------------------------------
(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
["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"
["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
["-" 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]
["-----" 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]
;; 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.
(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))
;;; provide ourselves
(provide 'ada-mode)
-;; arch-tag: 1b7d45ec-1698-43b5-8d4a-e479ea023270
;;; ada-mode.el ends here
HCoop / bpt / emacs.git / blobdiff