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

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