-;;; ada-fix-error.el --- utilities for automatically fixing
+;;; ada-fix-error.el --- utilities for automatically fixing -*- lexical-binding:t -*-
;; errors reported by the compiler.
-;; Copyright (C) 1999-2009, 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 1999-2009, 2012-2015 Free Software Foundation, Inc.
;; Author : Stephen Leake <Stephen_Leake@stephe-leake.org>
;; Maintainer : Stephen Leake <Stephen_Leake@stephe-leake.org>
(require 'compile)
(defcustom ada-fix-sort-context-clause t
- "*If non-nil, sort context clause when inserting 'with'"
+ "*If non-nil, sort context clause when inserting `with'"
:type 'boolean
:group 'ada)
(ada-case-adjust-identifier)
(delete-char 1)))
+(defun ada-fix-sort-context-pred (a b)
+ "Predicate for `sort-subr'; sorts \"limited with\", \"private with\" last.
+Returns non-nil if a should preceed b in buffer."
+ ;; a, b are buffer ranges in the current buffer
+ (cl-flet
+ ((starts-with
+ (pat reg)
+ (string= pat (buffer-substring-no-properties (car reg)
+ (min (point-max)
+ (+(car reg) (length pat)))))))
+ (cond
+ ((and
+ (starts-with "limited with" a)
+ (starts-with "private with" b))
+ t)
+
+ ((and
+ (starts-with "limited with" a)
+ (not (starts-with "limited with" b)))
+ nil)
+
+ ((and
+ (not (starts-with "limited with" a))
+ (starts-with "limited with" b))
+ t)
+
+ ((and
+ (starts-with "private with" a)
+ (not (starts-with "private with" b)))
+ nil)
+
+ ((and
+ (not (starts-with "private with" a))
+ (starts-with "private with" b))
+ t)
+
+ (t
+ (> 0 (compare-buffer-substrings
+ nil (car a) (cdr a)
+ nil (car b) (cdr b))) )
+ )))
+
+(defun ada-fix-sort-context-clause (beg end)
+ "Sort context clauses in range BEG END."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (sort-subr nil 'forward-line 'end-of-line nil nil 'ada-fix-sort-context-pred)
+ )))
+
(defun ada-fix-add-with-clause (package-name)
"Add a with_clause for PACKAGE_NAME.
If ada-fix-sort-context-clause, sort the context clauses using
(when (and (< (car context-clause) (cdr context-clause))
ada-fix-sort-context-clause)
- ;; FIXME (later): this puts "limited with", "private with" at top of list; prefer at bottom
- (sort-lines nil (car context-clause) (point)))
+ (ada-fix-sort-context-clause (car context-clause) (point)))
))
(defun ada-fix-extend-with-clause (child-name)
)))
(defun ada-fix-add-use-type (type)
- "Insert 'use type' clause for TYPE at start of declarative part for current construct."
+ "Insert `use type' clause for TYPE at start of declarative part for current construct."
(ada-goto-declarative-region-start); leaves point after 'is'
(newline)
(insert "use type " type ";")
(indent-according-to-mode))
(defun ada-fix-add-use (package)
- "Insert 'use' clause for PACKAGE at start of declarative part for current construct."
+ "Insert `use' clause for PACKAGE at start of declarative part for current construct."
(ada-goto-declarative-region-start); leaves point after 'is'
(newline)
(insert "use " package ";")
point and return nil.")
(defun ada-get-compilation-message ()
- "Get compilation message at point.
-Compatible with Emacs 23.4 and 24.x."
- (cl-case emacs-major-version
- (23 (get-text-property (line-beginning-position) 'message))
- (24 (get-text-property (line-beginning-position) 'compilation-message))))
+ "Get compilation message at line beginning."
+ (get-text-property (line-beginning-position) 'compilation-message))
(defun ada-fix-compiler-error ()
"Attempt to fix the current compiler error. Leave point at fixed code."
(with-current-buffer compilation-last-buffer
(when (not (ada-get-compilation-message))
- ;; not clear why this can happens, but it does
+ (beep)
+ (message "FIXME: ada-fix-compiler-error")
+ ;; not clear why this can happen, but it has
(compilation-next-error 1))
(let ((comp-buf-pt (point))
(success