;;; ada-mode.el --- major-mode for editing Ada sources
;;
-;;; Copyright (C) 1994, 1995, 1997 - 2013 Free Software Foundation, Inc.
+;;; Copyright (C) 1994, 1995, 1997 - 2014 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake <stephen_leake@member.fsf.org>
;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
;; Keywords FIXME: languages, ada ELPA broken for multiple keywords
-;; Version: 5.0
-;; package-requires: ((wisi "1.0"))
+;; Version: 5.1.3
+;; package-requires: ((wisi "1.0.4") (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)
;;
;; alist entries are set during load by the implementation elisp files.
;;
-;; `ada-prj-parse-file-ext' uses this style.
+;; `ada-prj-default-compiler-alist' uses this style.
;;; History:
;;
;; robin-reply@reagans.org
;; and others for their valuable hints.
-(require 'find-file)
(require 'align)
-(require 'which-func)
+(require 'cl-lib)
(require 'compile)
-
-(eval-when-compile (require 'cl-macs))
+(require 'find-file)
(defun ada-mode-version ()
"Return Ada mode version."
(interactive)
- (let ((version-string "5.0"))
+ (let ((version-string "5.1.3"))
;; must match:
;; ada-mode.texi
;; README
(defcustom ada-case-keyword 'downcase-word
"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 an Ada keywords."
+Function to call to adjust the case of Ada keywords."
:type '(choice (const downcase-word)
(const upcase-word))
:group 'ada
:safe 'functionp)
(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."
+ :type '(choice (const ada-mixed-case)
+ (const downcase-region)
+ (const upcase-region))
+ :group 'ada
+ :safe 'functionp)
+(make-variable-buffer-local 'ada-case-identifier)
+
(defcustom ada-case-strict t
"Buffer-local value that may override project variable `case_strict'.
Global value is default for project variable `case_strict'.
(make-variable-buffer-local 'ada-case-strict)
(defcustom ada-language-version 'ada2012
- "Ada language version; one of `ada83', `ada95', `ada2005'.
-Only affects the keywords to highlight."
+ "Ada language version; one of `ada83', `ada95', `ada2005', `ada2012'.
+Only affects the keywords to highlight, not which version the
+indentation parser accepts."
:type '(choice (const ada83)
(const ada95)
(const ada2005)
"Comment fill prefix."
:type 'string
:group 'ada)
+(make-variable-buffer-local 'ada-language-version)
(defcustom ada-fill-comment-postfix " --"
"Comment fill postfix."
:type 'string
:group 'ada)
+(make-variable-buffer-local 'ada-language-version)
(defcustom ada-prj-file-extensions '("adp" "prj")
"List of Emacs Ada mode project file extensions.
;;;; keymap and menus
+(defvar ada-ret-binding nil)
+(defvar ada-lfd-binding nil)
+
+(defun ada-case-activate-keys ()
+ "Modify the key bindings for all the keys that should adjust casing."
+ (interactive)
+ ;; We can't use post-self-insert-hook for \n, \r, because they are
+ ;; not self-insert.
+
+ ;; The 'or ...' is there to be sure that the value will not be
+ ;; changed again when this is called more than once, since we
+ ;; are rebinding the keys.
+ (or ada-ret-binding (setq ada-ret-binding (key-binding "\C-M")))
+ (or ada-lfd-binding (setq ada-lfd-binding (key-binding "\C-j")))
+
+ (mapc (function
+ (lambda(key)
+ (define-key
+ ada-mode-map
+ (char-to-string key)
+ 'ada-case-adjust-interactive)))
+ '( ?_ ?% ?& ?* ?( ?) ?- ?= ?+
+ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))
+
+ (define-key ada-mode-map [return] 'ada-case-adjust-interactive)
+ )
+
(defvar ada-mode-map
(let ((map (make-sparse-keymap)))
;; C-c <letter> are reserved for users
;; global-map has C-x ` 'next-error
(define-key map [return] 'ada-indent-newline-indent)
(define-key map "\C-c`" 'ada-show-secondary-error)
+ (define-key map "\C-c;" (lambda () (error "use M-; instead"))) ; comment-dwim
(define-key map "\C-c\M-`" 'ada-fix-compiler-error)
(define-key map "\C-c\C-a" 'ada-align)
(define-key map "\C-c\C-b" 'ada-make-subprogram-body)
)
("Edit"
["Expand skeleton" ada-expand t]
- ["Indent line" indent-for-tab-command t]
+ ["Indent line or selection" indent-for-tab-command t]
["Indent current statement" ada-indent-statement t]
["Indent lines in file" (indent-region (point-min) (point-max)) t]
["Align" ada-align t]
- ["Comment selection" comment-region t]
- ["Uncomment selection" (comment-region t) t]
+ ["Comment/uncomment selection" comment-dwim t]
["Fill comment paragraph" ada-fill-comment-paragraph t]
["Fill comment paragraph justify" (ada-fill-comment-paragraph 'full) t]
["Fill comment paragraph postfix" (ada-fill-comment-paragraph 'full t) t]
("Misc"
["Show last parse error" ada-show-parse-error t]
["Refresh cross reference cache" ada-xref-refresh t]
+ ["Reset parser" ada-reset-parser t]
)))
+(ada-case-activate-keys)
;; This doesn't need to be buffer-local because there can be only one
;; popup menu at a time.
(easy-menu-define ada-context-menu nil
"Context menu keymap for Ada mode"
'("Ada"
- ["Make body for subprogram" ada-make-subprogram-body t] ;; FIXME: include only if will succeed
+ ["Make body for subprogram" ada-make-subprogram-body t]
["Goto declaration/body" ada-goto-declaration :included ada-context-menu-on-identifier]
["Show parent declarations" ada-show-declaration-parents :included ada-context-menu-on-identifier]
["Show references" ada-show-references :included ada-context-menu-on-identifier]
["Show overriding" ada-show-overriding :included ada-context-menu-on-identifier]
["Show overridden" ada-show-overridden :included ada-context-menu-on-identifier]
- ["Expand skeleton" ada-expand t] ;; FIXME: only if skeleton
+ ["Expand skeleton" ada-expand t]
["Create full case exception" ada-case-create-exception t]
["Create partial case exception" ada-case-create-partial-exception t]
(modes . '(ada-mode)))
(ada-comment
(regexp . "\\(\\s-*\\)--")
+ (valid . (lambda () (ada-align-valid)))
(modes . '(ada-mode)))
(ada-use
(regexp . "\\(\\s-*\\)\\<\\(use\\s-\\)")
(defun ada-align-valid ()
"See use in `ada-align-rules'."
(save-excursion
- ;; we don't put "when (match-beginning 2)" here; missing a match
+ ;; we don't put "when (match-beginning n)" here; missing a match
;; is a bug in the regexp.
- (goto-char (match-beginning 2))
+ (goto-char (or (match-beginning 2) (match-beginning 1)))
(not (ada-in-string-or-comment-p))))
(defconst ada-align-region-separate
(setq access-p (or access-p (nth 4 param)))
)
- (unless (save-excursion (skip-chars-backward " \t") (bolp))
- ;; paramlist starts on same line as subprogram identifier; clean up whitespace
- (end-of-line)
- (delete-char (- (skip-syntax-backward " ")))
- (insert " "))
+ (let ((space-before-p (save-excursion (skip-chars-backward " \t") (not (bolp))))
+ (space-after-p (save-excursion (skip-chars-forward " \t") (not (eolp)))))
+ (when space-before-p
+ ;; paramlist starts on same line as subprogram identifier; clean
+ ;; up whitespace. Allow for code on same line as closing paren
+ ;; ('return' or ';').
+ (skip-syntax-forward " ")
+ (delete-char (- (skip-syntax-backward " ")))
+ (if space-after-p
+ (progn
+ (insert " ")
+ (forward-char -1))
+ (insert " "))
+ ))
(insert "(")
)
))
+(defvar ada-reset-parser nil
+ ;; Supplied by indentation engine parser
+ "Function to reset parser, to clear confused state."
+ )
+
+(defun ada-reset-parser ()
+ (interactive)
+ (when ada-reset-parser
+ (funcall ada-reset-parser)))
+
(defvar ada-show-parse-error nil
;; Supplied by indentation engine parser
"Function to show last error reported by indentation parser."
(car casing))
(t
- (error
- "No exception file specified. See variable `ada-case-exception-file'")))
- ))
+ (if ada-prj-current-file
+ (error "No exception file specified; set `casing' in project file.")
+ ;; IMPROVEME: could prompt, but then need to write to actual project file
+ ;; (let ((temp
+ ;; (read-file-name
+ ;; "No exception file specified; adding to project. file: ")))
+ ;; (message "remember to add %s to project file" temp)
+ ;; (ada-prj-put 'casing temp)
+ ;; temp)
+ (error "No exception file specified, and no project active. See variable `ada-case-exception-file'.")))
+ )))
(unless word
(if (use-region-p)
"Return t if point is after a prefix of a numeric literal."
(looking-back "\\([0-9]+#[0-9a-fA-F_]+\\)"))
+(defvar ada-keywords nil
+ "List of Ada keywords for current `ada-language-version'.")
+
(defun ada-after-keyword-p ()
"Return non-nil if point is after an element of `ada-keywords'."
(let ((word (buffer-substring-no-properties
(point))))
(member (downcase word) ada-keywords)))
+(defun ada-mixed-case (start end)
+ "Adjust case of region START END to Mixed_Case."
+ (let ((done nil)
+ next)
+ (if ada-case-strict
+ (downcase-region start end))
+ (goto-char start)
+ (while (not done)
+ (setq next
+ (or
+ (save-excursion (when (search-forward "_" end t) (point-marker)))
+ (copy-marker (1+ end))))
+
+ ;; upcase first char
+ (insert-char (upcase (following-char)) 1)
+ (delete-char 1)
+
+ (goto-char next)
+ (if (< (point) end)
+ (setq start (point))
+ (setq done t))
+ )))
+
(defun ada-case-adjust-identifier ()
"Adjust case of the previous word as an identifier.
-Uses Mixed_Case, with exceptions defined in
+Uses `ada-case-identifier', with exceptions defined in
`ada-case-full-exceptions', `ada-case-partial-exceptions'."
(interactive)
(save-excursion
(insert (car match))
(delete-region (point) end))
- ;; else apply Mixed_Case and partial-exceptions
- (if ada-case-strict
- (downcase-region start end))
+ ;; else apply ada-case-identifier
+ (funcall ada-case-identifier start end)
+
+ ;; apply partial-exceptions
+ (goto-char start)
(while (not done)
(setq next
(or
(save-excursion (when (search-forward "_" end t) (point-marker)))
(copy-marker (1+ end))))
- (if (setq match (assoc-string (buffer-substring-no-properties start (1- next))
+ (when (setq match (assoc-string (buffer-substring-no-properties start (1- next))
ada-case-partial-exceptions t))
- (progn
- ;; see comment above at 'full word exception' for why
- ;; we do insert first.
- (insert (car match))
- (delete-region (point) (1- next)))
-
- ;; else upcase first char
- (insert-char (upcase (following-char)) 1)
- (delete-char 1))
+ ;; see comment above at 'full word exception' for why
+ ;; we do insert first.
+ (insert (car match))
+ (delete-region (point) (1- next)))
(goto-char next)
(if (< (point) end)
(not (ada-in-numeric-literal-p))
))
- (cond
- ;; Some attributes are also keywords, but captialized as
- ;; attributes. So check for attribute first.
- ((and
- (not in-comment)
- (save-excursion
- (skip-syntax-backward "w_")
- (eq (char-before) ?')))
- (ada-case-adjust-identifier))
-
- ((and
- (not in-comment)
- (not (eq typed-char ?_))
- (ada-after-keyword-p))
- (funcall ada-case-keyword -1))
-
- (t (ada-case-adjust-identifier))
- ))
- ))
+ ;; The indentation engine may trigger a reparse on
+ ;; non-whitespace changes, but we know we don't need to reparse
+ ;; for this change (assuming the user has not abused case
+ ;; exceptions!).
+ (let ((inhibit-modification-hooks t))
+ (cond
+ ;; Some attributes are also keywords, but captialized as
+ ;; attributes. So check for attribute first.
+ ((and
+ (not in-comment)
+ (save-excursion
+ (skip-syntax-backward "w_")
+ (eq (char-before) ?')))
+ (ada-case-adjust-identifier))
+
+ ((and
+ (not in-comment)
+ (not (eq typed-char ?_))
+ (ada-after-keyword-p))
+ (funcall ada-case-keyword -1))
+
+ (t (ada-case-adjust-identifier))
+ ))
+ )))
(defun ada-case-adjust-at-point (&optional in-comment)
"Adjust case of word at point, move to end of word.
(interactive "P")
(when
(and (not (eobp))
- (memq (char-syntax (char-after)) '(?w ?_)))
+ ;; we use '(syntax-after (point))' here, not '(char-syntax
+ ;; (char-after))', because the latter does not respect
+ ;; ada-syntax-propertize.
+ (memq (syntax-class (syntax-after (point))) '(2 3)))
(skip-syntax-forward "w_"))
(ada-case-adjust nil in-comment))
(ada-case-adjust-region (point-min) (point-max)))
(defun ada-case-adjust-interactive (arg)
- "Adjust the case of the previous word, and process the character just typed.
+ "If `ada-auto-case' is non-nil, adjust the case of the previous word, and process the character just typed.
To be bound to keys that should cause auto-casing.
ARG is the prefix the user entered with \\[universal-argument]."
(interactive "P")
(cond
((eq lastk ?\n)
- (ada-case-adjust lastk)
- (funcall ada-lfd-binding))
+ (when ada-auto-case
+ (ada-case-adjust lastk))
+ (funcall ada-lfd-binding))
- ((eq lastk ?\r)
- (ada-case-adjust lastk)
+ ((memq lastk '(?\r return))
+ (when ada-auto-case
+ (ada-case-adjust lastk))
(funcall ada-ret-binding))
(t
- (ada-case-adjust lastk)
+ (when ada-auto-case
+ (ada-case-adjust lastk))
(self-insert-command (prefix-numeric-value arg)))
- )
- ))
-
-(defvar ada-ret-binding nil)
-(defvar ada-lfd-binding nil)
-
-(defun ada-case-activate-keys ()
- "Modify the key bindings for all the keys that should adjust casing."
- (interactive)
- ;; We can't use post-self-insert-hook for \n, \r, because they are
- ;; not self-insert. So we make ada-mode-map buffer local, and don't
- ;; call this function if ada-auto-case is off. That means
- ;; ada-auto-case cannot be changed after an Ada buffer is created.
-
- ;; The 'or ...' is there to be sure that the value will not be
- ;; changed again when Ada mode is called more than once, since we
- ;; are rebinding the keys.
- (or ada-ret-binding (setq ada-ret-binding (key-binding "\C-M")))
- (or ada-lfd-binding (setq ada-lfd-binding (key-binding "\C-j")))
-
- (mapcar (function
- (lambda(key)
- (define-key
- ada-mode-map
- (char-to-string key)
- 'ada-case-adjust-interactive)))
- '( ?_ ?% ?& ?* ?( ?) ?- ?= ?+
- ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?/ ?\n 32 ?\r ))
- )
+ )))
;;;; project files
(defun ada-prj-get (prop &optional plist)
"Return value of PROP in PLIST.
Optional PLIST defaults to `ada-prj-current-project'."
- (plist-get (or plist ada-prj-current-project) prop))
+ (let ((prj (or plist ada-prj-current-project)))
+ (if prj
+ (plist-get prj prop)
+
+ ;; no project, just use default vars
+ ;; must match code in ada-prj-default
+ (cl-case plist
+ (ada_compiler ada-compiler)
+ (auto_case ada-auto-case)
+ (case_keyword ada-case-keyword)
+ (case_identifier ada-case-identifier)
+ (case_strict ada-case-strict)
+ (casing (if (listp ada-case-exception-file)
+ ada-case-exception-file
+ (list ada-case-exception-file)))
+ (path_sep path-separator)
+ (proc_env process-environment)
+ (src_dir (list "."))
+ (xref_tool ada-xref-tool)
+ ))))
(defun ada-prj-put (prop val &optional plist)
"Set value of PROP in PLIST to VAL.
(list
;; variable name alphabetical order
'ada_compiler ada-compiler
- 'ada_ref_tool ada-xref-tool
'auto_case ada-auto-case
'case_keyword ada-case-keyword
+ 'case_identifier ada-case-identifier
'case_strict ada-case-strict
'casing (if (listp ada-case-exception-file)
ada-case-exception-file
(lambda (ext) (cons ext 'ada-prj-parse-file-1))
ada-prj-file-extensions)
;; project file parse
- "Alist of parsers for project files.
+ "Alist of parsers for project files, indexed by file extension.
Default provides the minimal Ada mode parser; compiler support
code may add other parsers. Parser is called with two arguments;
the project file name and the current project property
(setq prj-file (expand-file-name prj-file))
+ (unless (file-readable-p prj-file)
+ (error "Project file '%s' is not readable" prj-file))
+
(if parser
;; parser may reference the "current project", so bind that now.
(let ((ada-prj-current-project project)
((string= (match-string 1) "case_keyword")
(setq project (plist-put project 'case_keyword (intern (match-string 2)))))
+ ((string= (match-string 1) "case_identifier")
+ (setq project (plist-put project 'case_identifier (intern (match-string 2)))))
+
((string= (match-string 1) "case_strict")
(setq project (plist-put project 'case_strict (intern (match-string 2)))))
"Assign `syntax-table' properties in accessible part of buffer.
In particular, character constants are set to have string syntax."
;; (info "(elisp)Syntax Properties")
- (let ((modified (buffer-modified-p))
- (buffer-undo-list t)
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (inhibit-modification-hooks t))
+ ;;
+ ;; called from `syntax-propertize', inside save-excursion with-silent-modifications
+ (let ((inhibit-read-only t)
+ (inhibit-point-motion-hooks t))
(goto-char start)
- (while (re-search-forward
- (concat
- "[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)"; 1, 2: character constants, not attributes
- "\\|[^a-zA-Z0-9)]\\('''\\)"; 3: character constant '''
- "\\|\\(--\\)"; 4: comment start
- )
- end t)
- ;; The help for syntax-propertize-extend-region-functions
- ;; implies that 'start end' will always include whole lines, in
- ;; which case we don't need
- ;; syntax-propertize-extend-region-functions
- (cond
- ((match-beginning 1)
- (put-text-property
- (match-beginning 1) (match-end 1) 'syntax-table '(7 . ?'))
- (put-text-property
- (match-beginning 2) (match-end 2) 'syntax-table '(7 . ?')))
- ((match-beginning 3)
- (put-text-property
- (match-beginning 3) (1+ (match-beginning 3)) 'syntax-table '(7 . ?'))
- (put-text-property
- (1- (match-end 3)) (match-end 3) 'syntax-table '(7 . ?')))
- ((match-beginning 4)
- (put-text-property
- (match-beginning 4) (match-end 4) 'syntax-table '(11 . nil)))
- ))
- (run-hook-with-args 'ada-syntax-propertize-hook start end)
- (unless modified
- (restore-buffer-modified-p nil))))
+ (save-match-data
+ (while (re-search-forward
+ (concat
+ "[^a-zA-Z0-9)]\\('\\)[^'\n]\\('\\)"; 1, 2: character literal, not attribute
+ "\\|[^a-zA-Z0-9)]\\('''\\)"; 3: character literal '''
+ "\\|\\(--\\)"; 4: comment start
+ )
+ end t)
+ ;; The help for syntax-propertize-extend-region-functions
+ ;; implies that 'start end' will always include whole lines, in
+ ;; which case we don't need
+ ;; syntax-propertize-extend-region-functions
+ (cond
+ ((match-beginning 1)
+ (put-text-property
+ (match-beginning 1) (match-end 1) 'syntax-table '(7 . ?'))
+ (put-text-property
+ (match-beginning 2) (match-end 2) 'syntax-table '(7 . ?')))
+ ((match-beginning 3)
+ (put-text-property
+ (match-beginning 3) (1+ (match-beginning 3)) 'syntax-table '(7 . ?'))
+ (put-text-property
+ (1- (match-end 3)) (match-end 3) 'syntax-table '(7 . ?')))
+ ((match-beginning 4)
+ (put-text-property
+ (match-beginning 4) (match-end 4) 'syntax-table '(11 . nil)))
+ )))
+ (run-hook-with-args 'ada-syntax-propertize-hook start end))
+ )
(defun ada-in-comment-p (&optional parse-result)
"Return t if inside a comment.
"Regexp for extracting the parent name from fully-qualified name.")
(defvar ada-file-name-from-ada-name nil
- ;; depends on ada-compiler, per-project
+ ;; determined by ada-xref-tool, set by *-select-prj
"Function called with one parameter ADA-NAME, which is a library
unit name; it should return the filename in which ADA-NAME is
found.")
;; This will still be confused by multiple references; we need
;; to use compiler cross reference info for more precision.
(while (not done)
- (when (search-forward-regexp ff-function-name nil t)
- (setq found (match-beginning 0)))
+ (if (search-forward-regexp ff-function-name nil t)
+ (setq found (match-beginning 0))
+ ;; not in remainder of buffer
+ (setq done t))
(if (ada-in-string-or-comment-p)
(setq found nil)
(setq done t)))
FILE may be absolute, or on `compilation-search-path'.
If OTHER-WINDOW is non-nil, show the buffer in another window."
- (setq file (ff-get-file-name compilation-search-path file))
+ (let ((file-1
+ (if (file-name-absolute-p file) file
+ (ff-get-file-name compilation-search-path file))))
+ (if file-1
+ (setq file file-1)
+ (error "File %s not found; installed library, or set project?" file))
+ )
+
(let ((buffer (get-file-buffer file)))
(cond
((bufferp buffer)
"Function that returns cross reference information.
Function is called with four arguments:
- an Ada identifier or operator_symbol
-- filename containing the identifier
+- filename containing the identifier (full path)
- line number containing the identifier
- column of the start of the identifier
Returns a list '(file line column) giving the corresponding location.
(let ((target
(funcall ada-xref-other-function
(ada-identifier-at-point)
- (file-name-nondirectory (buffer-file-name))
+ (buffer-file-name)
(line-number-at-pos)
(1+ (current-column))
)))
(ada-identifier-at-point)
(file-name-nondirectory (buffer-file-name))
(line-number-at-pos)
- (cl-case (char-after)
- (?\" (+ 2 (current-column))) ;; FIXME: work around bug in gnat find
- (t (1+ (current-column)))))
+ (1+ (current-column)))
)
(defvar ada-xref-overriding-function nil
(error "`ada-make-subprogram-body' not set")))
(defvar ada-make-package-body nil
- ;; Supplied by compiler
+ ;; Supplied by xref tool
"Function to create a package body from a package spec.
Called with one argument; the absolute path to the body
file. Current buffer is the package spec. Should create the
package body file, containing skeleton code that will compile.")
(defun ada-make-package-body (body-file-name)
- (if ada-make-package-body
- (funcall ada-make-package-body body-file-name)
- (error "`ada-make-package-body' not set")))
+ ;; no error if not set; let ada-skel do its thing.
+ (when ada-make-package-body
+ (funcall ada-make-package-body body-file-name)))
(defun ada-ff-create-body ()
- ;; ff-find-other-file calls us with point in an empty buffer for the
- ;; body file; ada-make-package-body expects to be in the spec. So go
- ;; back.
- (let ((body-file-name (buffer-file-name)))
- (ff-find-the-other-file)
- (ada-make-package-body body-file-name)
- ;; FIXME (later): if 'ada-make-package-body' fails, delete the body buffer
- ;; so it doesn't get written to disk, and we can try again.
-
- ;; back to the body, read in from the disk.
- (ff-find-the-other-file)
- (revert-buffer t t)
+ ;; no error if not set; let ada-skel do its thing.
+ (when ada-make-package-body
+ ;; ff-find-other-file calls us with point in an empty buffer for the
+ ;; body file; ada-make-package-body expects to be in the spec. So go
+ ;; back.
+ (let ((body-file-name (buffer-file-name)))
+ (ff-find-the-other-file)
+
+ (ada-make-package-body body-file-name)
+ ;; FIXME (later): if 'ada-make-package-body' fails, delete the body buffer
+ ;; so it doesn't get written to disk, and we can try again.
+
+ ;; back to the body, read in from the disk.
+ (ff-find-the-other-file)
+ (revert-buffer t t))
))
;;;; fill-comment
'("some")
"List of keywords new in Ada 2012.")
-(defvar ada-keywords nil
- "List of Ada keywords for current `ada-language-version'.")
-
(defun ada-font-lock-keywords ()
"Return Ada mode value for `font-lock-keywords', depending on `ada-language-version'."
(list
;;;; ada-mode
+;; ada-mode does not derive from prog-mode, because we need to call
+;; ada-mode-post-local-vars, and prog-mode does not provide a way to
+;; do that.
+;;
;; autoload required by automatic mode setting
;;;###autoload
(defun ada-mode ()
ff-file-created-hook 'ada-ff-create-body)
(add-hook 'ff-pre-load-hook 'ada-which-function)
(setq ff-search-directories 'compilation-search-path)
+ (when (null (car compilation-search-path))
+ ;; find-file doesn't handle nil in search path
+ (setq compilation-search-path (list (file-name-directory (buffer-file-name)))))
(ada-set-ff-special-constructs)
(set (make-local-variable 'add-log-current-defun-function)
'ada-add-log-current-function)
- (add-hook 'which-func-functions 'ada-which-function nil t)
+ (when (boundp 'which-func-functions)
+ (add-hook 'which-func-functions 'ada-which-function nil t))
;; Support for align
(add-to-list 'align-dq-string-modes 'ada-mode)
;; This means to fully set ada-mode interactively, user must
;; do M-x ada-mode M-; (hack-local-variables)
- (when ada-auto-case (ada-case-activate-keys))
-
(when global-font-lock-mode
;; This calls ada-font-lock-keywords, which depends on
;; ada-language-version
(unless (featurep 'ada-indent-engine)
(require 'ada-wisi))
+(unless (featurep 'ada-xref-tool)
+ (cl-case ada-xref-tool
+ ((nil 'gnat) (require 'ada-gnat-xref))
+ ('gnat_inspect (require 'gnat-inspect))
+ ('gpr_query (require 'gpr-query))
+ ))
+
(unless (featurep 'ada-compiler)
(require 'ada-gnat-compile))
-(unless (featurep 'ada-xref-tool)
- (require 'ada-gnat-xref))
-
(unless (featurep 'ada-skeletons)
(require 'ada-skel))
+(when (featurep 'imenu)
+ (require 'ada-imenu))
+
;;; end of file