code.delx.au - gnu-emacs-elpa/blob - packages/ada-mode/gpr-mode.el

   1 ;;; gpr-mode --- major-mode for editing GNAT project files
   2
   3 ;; Copyright (C) 2004, 2007, 2008, 2012-2013  Free Software Foundation, Inc.
   4
   5 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
   6 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
   7 ;; Version: 5.0
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; gpr-mode is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 3, or (at your option)
  14 ;; any later version.
  15
  16 ;; gpr-mode is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25 ;;
  26 ;;; Commentary:
  27 ;;
  28 ;;; History:
  29 ;;
  30 ;; The first gpr-mode was written by Rolf Ebert
  31 ;; <rolf.ebert_nosp...@gmx.net> in 2004.
  32 ;;
  33 ;; Stephen Leake <stephen_leake@member.fsf.org> rewrote it in 2013 to
  34 ;; use the wisi indentation engine.
  35 ;;
  36 ;;;;; Code:
  37
  38 ;; we reuse several ada-mode functions
  39 (require 'ada-mode)
  40
  41 (defun gpr-align ()
  42   "If region is active, apply 'align'. If not, attempt to align
  43 current construct."
  44   (interactive)
  45   (if (use-region-p)
  46       (progn
  47         (align (region-beginning) (region-end))
  48         (deactivate-mark))
  49
  50     (align-current)
  51     ))
  52
  53 (defvar gpr-mode-map
  54   (let ((map (make-sparse-keymap)))
  55     ;; C-c <letter> are reserved for users
  56
  57     ;; global-map has C-x ` 'next-error
  58     (define-key map [return]   'ada-indent-newline-indent)
  59     (define-key map "\C-c`"    'ada-show-secondary-error)
  60     (define-key map "\C-c\C-a" 'gpr-align)
  61     (define-key map "\C-c\C-c" 'compile)
  62     (define-key map "\C-c\C-e" 'gpr-expand)
  63     (define-key map "\C-c\C-f" 'gpr-show-parse-error)
  64     (define-key map "\C-c\C-i" 'gpr-indent-statement)
  65             ;; FIXME (later): implement?
  66     ;; (define-key map "\C-c\C-n" 'ada-next-statement-keyword)
  67     ;; (define-key map "\C-c\C-p" 'ada-prev-statement-keyword)
  68     (define-key map "\C-c\C-S-p" 'gpr-set-as-project)
  69     (define-key map "\C-c\C-t" 'ada-case-read-all-exceptions)
  70     (define-key map "\C-c\C-w" 'ada-case-adjust-at-point)
  71     (define-key map "\C-c\C-y" 'ada-case-create-exception)
  72     (define-key map "\C-c\C-\M-y" (lambda () (ada-case-create-exception nil nil t)))
  73     map
  74   )  "Local keymap used for GPR mode.")
  75
  76 (defvar gpr-mode-menu (make-sparse-keymap "gpr"))
  77 (easy-menu-define gpr-mode-menu gpr-mode-map "Menu keymap for gpr mode"
  78   '("gpr"
  79     ("Help"
  80      ["gpr Mode"              (info "gpr-mode") t]
  81      ["GNAT Reference Manual" (info "gnat_rm") t]
  82      ["GNAT User Guide"       (info "gnat_ugn") t]
  83      ["Key bindings"          describe-bindings t]
  84      )
  85
  86     ["Customize"     (customize-group 'ada)];; we reuse the Ada indentation options
  87     ["------"        nil nil]
  88     ["Find and select project ..." ada-build-prompt-select-prj-file t]
  89     ["Select project ..."          ada-prj-select                   t]
  90     ["Set as current project"      gpr-set-as-project               t]
  91     ["Show current project"        ada-prj-show                     t]
  92     ["Next compilation error"      next-error                       t]
  93     ["Show secondary error"        ada-show-secondary-error         t]
  94     ["Show last parse error"       gpr-show-parse-error             t]
  95     ("Edit"
  96      ["Indent Line"                 indent-for-tab-command         t]
  97      ["Indent Lines in Selection"   indent-region                  t]
  98      ["Indent Lines in File"        (indent-region (point-min) (point-max))  t]
  99      ["Expand skeleton"             gpr-expand                     t] ;; FIXME: only if skeleton
 100      ["Align"                       gpr-align                      t]
 101      ["Comment Selection"           comment-region                 t]
 102      ["Uncomment Selection"         (lambda () (comment-region t)) t]
 103      ["Fill Comment Paragraph"      fill-paragraph                 t]
 104
 105      ["Fill Comment Paragraph Justify" ada-fill-comment-paragraph-justify t]
 106      ["Fill Comment Paragraph Postfix" ada-fill-comment-paragraph-postfix t]
 107      )
 108     ))
 109
 110 (defvar gpr-show-parse-error nil
 111   ;; Supplied by indentation engine parser
 112   "Function to show last error reported by indentation parser."
 113   )
 114
 115 (defun gpr-show-parse-error ()
 116   (interactive)
 117   (when gpr-show-parse-error
 118     (funcall gpr-show-parse-error)))
 119
 120 (defvar gpr-expand nil
 121   ;; skeleton function
 122   "Function to call to expand tokens (ie insert skeletons).")
 123
 124 (defun gpr-expand ()
 125   "Expand previous word into a statement skeleton."
 126   (interactive)
 127   (when gpr-expand
 128     (funcall gpr-expand)))
 129
 130 (defvar gpr-indent-statement nil
 131   ;; indentation function
 132   "Function to indent the statement/declaration point is in or after.
 133 Function is called with no arguments.")
 134
 135 (defun gpr-indent-statement ()
 136   "Indent current statement."
 137   (interactive)
 138   (when gpr-indent-statement
 139     (funcall gpr-indent-statement)))
 140
 141 (defvar gpr-font-lock-keywords
 142   (progn
 143     (list
 144      ;;
 145      ;; keyword plus name.
 146      (list (concat
 147             "\\<\\("
 148             "package\\|"
 149             "project\\|"
 150             "for"
 151             "\\)\\>[ \t]*"
 152             "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
 153            '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t))
 154      ;;
 155      ;; Main keywords
 156      (list (concat "\\<"
 157                    (regexp-opt
 158                     '("abstract" "aggregate" "case" "configuration" "external" "is" "library" "null" "others"
 159                       "renames" "standard" "type" "use" "when" "with") t)
 160                    "\\>")
 161            '(1 font-lock-keyword-face))
 162      ;;
 163      ;; Anything following end and not already fontified is a body name.
 164      '("\\<\\(end\\)\\>\\([ \t]+\\)?\\(\\(\\sw\\|[_.]\\)+\\)?"
 165        (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
 166      ;;
 167      ))
 168   "Expressions to highlight in gpr mode.")
 169
 170 (defun gpr-ff-special-with ()
 171   (ada-require-project-file)
 172   (let ((project-path (match-string 1)))
 173     ;; project-path may be any of "foo", "foo.gpr", "../foo.gpr"
 174     ;;
 175     ;; The result of ff-special-constructs is used by
 176     ;; ff-find-the-other-file with ff-search-directories and nil
 177     ;; suffix list, so it must contain the relative path and the
 178     ;; suffix
 179     (if (file-name-extension project-path)
 180         project-path
 181       (concat project-path ".gpr"))
 182     ))
 183
 184 (defun gpr-set-ff-special-constructs ()
 185   "Add gpr-specific pairs to `ff-special-constructs'."
 186   (set (make-local-variable 'ff-special-constructs) nil)
 187   (mapc (lambda (pair) (add-to-list 'ff-special-constructs pair))
 188         ;; Each car is a regexp; if it matches at point, the cdr is
 189         ;; invoked.  Each cdr should return the absolute file name to
 190         ;; go to.
 191         (list
 192          ;; A "with" clause; allow "foo_bar.gpr" and "../foo"
 193          (cons "^with[ \t]+\"\\(\\(?:\\(?:\\sw\\|\\s.\\)\\|\\s_\\)+\\)\";"
 194                'gpr-ff-special-with)
 195          )))
 196
 197 (defvar gpr-which-function nil
 198   ;; supplied by the indentation engine
 199   "Function called with no parameters; it should return the name
 200 of the package or project point is in or just after, or nil.")
 201
 202 (defun gpr-which-function ()
 203   "See `gpr-which-function' variable."
 204   (when gpr-which-function
 205     (funcall gpr-which-function)))
 206
 207 (defun gpr-add-log-current-function ()
 208   "For `add-log-current-defun-function'. Returns enclosing package or project name."
 209   ;; add-log-current-defun is typically called with point at the start
 210   ;; of an ediff change section, which is before the start of the
 211   ;; declaration of a new item. So go to the end of the current line
 212   ;; first
 213   (save-excursion
 214     (end-of-line 1)
 215     (gpr-which-function)))
 216
 217 (defun gpr-set-as-project (&optional file)
 218   "Set FILE (default current buffer file) as Emacs project file."
 219   (interactive)
 220   (ada-parse-prj-file (or file (buffer-file-name)))
 221   (ada-select-prj-file (or file (buffer-file-name))))
 222
 223 ;;;;
 224 (defun gpr-mode ()
 225   "The major mode for editing GNAT project files."
 226
 227   (interactive)
 228   (kill-all-local-variables)
 229   (setq major-mode 'gpr-mode)
 230   (setq mode-name "GNAT Project")
 231   (use-local-map gpr-mode-map)
 232   (set-syntax-table ada-mode-syntax-table)
 233   (set (make-local-variable 'syntax-begin-function) nil)
 234   (set 'case-fold-search t); gpr is case insensitive; the syntax parsing requires this setting
 235   (set (make-local-variable 'comment-start) "--")
 236   (set (make-local-variable 'comment-end) "")
 237   (set (make-local-variable 'comment-start-skip) "---*[ \t]*")
 238   (set (make-local-variable 'comment-multi-line) nil)
 239
 240   (set (make-local-variable 'require-final-newline) t)
 241
 242   (set (make-local-variable 'font-lock-defaults)
 243        '(gpr-font-lock-keywords
 244          nil t
 245          ((?\_ . "w"))))
 246
 247   (gpr-set-ff-special-constructs)
 248   (setq ff-search-directories 'ada-project-search-path)
 249
 250   (set (make-local-variable 'add-log-current-defun-function)
 251        'gpr-add-log-current-function)
 252
 253   ;; used by autofill to break a comment line and continue it on
 254   ;; another line. The reason we need this one is that the default
 255   ;; behavior does not work correctly with the definition of
 256   ;; paragraph-start above when the comment is right after a
 257   ;; multi-line subprogram declaration (the comments are aligned under
 258   ;; the latest parameter, not under the declaration start).
 259   ;; FIXME: need test - should be in gpr-wisi?
 260   (set (make-local-variable 'comment-line-break-function)
 261        (lambda (&optional soft) (let ((fill-prefix nil))
 262                                   (indent-new-comment-line soft))))
 263
 264   (run-hooks 'gpr-mode-hook)
 265
 266   )
 267
 268 ;; user needs to add this somewhere:
 269 ;; FIXME: add autoload processing?
 270 (add-to-list 'auto-mode-alist '("\\.gpr\\'" . gpr-mode))  ; GNAT project files
 271
 272 (provide 'gpr-mode)
 273
 274 (unless (featurep 'gpr-indent-engine)
 275   (require 'gpr-wisi))
 276
 277 ;;; end of file