wesnoth-mode.el

   1 ;;; wesnoth-mode.el --- A major mode for editing WML.
   2 ;; Copyright (C) 2006, 2007, 2008 Chris Mann
   3
   4 ;; This program is free software; you can redistribute it and/or
   5 ;; modify it under the terms of the GNU General Public License as
   6 ;; published by the Free Software Foundation; either version 2 of the
   7 ;; License, or (at your option) any later version.
   8
   9 ;; This program is distributed in the hope that it will be useful, but
  10 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  12 ;; General Public License for more details.
  13
  14 ;; You should have received a copy of the GNU General Public License
  15 ;; along with this program; see the file COPYING.  If not, write to the
  16 ;; Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,
  17 ;; MA 02139, USA.
  18
  19 ;;; Description:
  20 ;; wesnoth-mode is a major mode for Emacs which assists in the editing
  21 ;; of Wesnoth Markup Language (WML) files.  Currently, this mode
  22 ;; features syntax highlighting support, automatic indentation,
  23 ;; tag-completion and preliminary support for syntax checking.
  24
  25 ;;; Commentary:
  26 ;; Add the following to your .emacs:
  27 ;;   (add-to-list 'load-path "path/to/wesnoth-mode")
  28 ;;   (autoload 'wesnoth-mode "wesnoth-mode" "Major mode for editing WML." t)
  29 ;; Optionally adding:
  30 ;;   (add-to-list 'auto-mode-alist '("\\.cfg\\'" . wesnoth-mode))
  31 ;; to automatically load wesnoth-mode for all files ending in '.cfg'.
  32
  33 ;;; History:
  34 ;; 1.3.0
  35 ;; * WML checking is now context sensitive; checks attributes and macros.
  36 ;; * WML checks are now always performed on the entire buffer, with results
  37 ;;   displayed in a temporary buffer.
  38 ;; * Context-sensitive completion for attributes and tags.
  39 ;; * Completion for built-in and project-specific macros.
  40 ;; * Changed the following bindings:
  41 ;;   `wesnoth-insert-tag' - C-c e -> C-c t
  42 ;;   `wesnoth-jump-to-matching' - C-c m -> C-c o
  43 ;;   `wesnoth-check-structure' -> `wesnoth-check-wml' - C-c c
  44 ;; * Added the following bindings:
  45 ;;   `wesnoth-complete-attribute' - C-c a
  46 ;;   `wesnoth-complete-macro' - C-c m
  47 ;;   `wesnoth-complete-tag' - C-c t
  48 ;; * Removed the following bindings:
  49 ;;   `wesnoth-check-tag-names' - C-c n
  50 ;; * Removed `wesnoth-check-tag-names'.  Replaced by `wesnoth-check-wml'.
  51 ;; * Completion for an incomplete attribute, tag, or macro at point is
  52 ;;   attempted via TAB.
  53 ;; 1.2.5
  54 ;; * Fixed support for GNU Emacs 21.
  55 ;; * Added several new tags to `wesnoth-tags-list'.
  56 ;; * Added M-TAB binding for `wesnoth-insert-tag'.
  57 ;; * `wesnoth-insert-tag' now takes an optional numeric argument indicating
  58 ;;   how many blocks to wrap across instead of a region.
  59 ;; * Support for `wesnoth-indent-preprocessor-bol' removed.
  60 ;; * Fixed a bug in `wesnoth-insert-tag' and `wesnoth-insert-missing-closing'
  61 ;;   causing tags not to be inserted in the correct position.
  62 ;; * Fixed highlighting of array indexes as tags.
  63 ;; 1.2.4
  64 ;; * Improved syntax-highlighting for macro calls.
  65 ;; * Underscore is now treated as whitespace.
  66 ;; * Fixed incorrect indentation when preprocessor preceeded by whitespace.
  67 ;; * Point is now placed at the first non-whitespace character of the line,
  68 ;;   instead of the last.
  69 ;; * Corrected minor indentation bugs.
  70 ;; * Indenting across large regions is now much more efficient.
  71 ;; * Fix hooks modifying wesnoth-mode-map causing default bindings not being
  72 ;;   applied.
  73 ;; 1.2.3
  74 ;; * Now compatible with GNU Emacs 21.4.
  75 ;; * Added support for several new tags.
  76 ;; * Added menu entry for wesnoth-mode.
  77 ;; * Significant speed increase to indentation.
  78 ;; * Indentation can now be customised using `wesnoth-indent-preprocessor-bol'
  79 ;;   and `wesnoth-indent-savefile'; support for `wesnoth-indentation-function'
  80 ;;   has been removed.
  81 ;; * Trailing whitespace is no longer created when creating a second
  82 ;;   consecutive newline.
  83 ;; * Spurious newlines are no longer created when inserting a tag elements
  84 ;;   around a region.
  85 ;; 1.2.2
  86 ;; * Added functions: `wesnoth-indent', `wesnoth-element-closing',
  87 ;;   `wesnoth-element', `wesnoth-element-opening',
  88 ;;   `wesnoth-insert-and-indent', `wesnoth-insert-missing-closing'.
  89 ;; * Renamed `wesnoth-indent-line-default', `wesnoth-indent-line-savefile' and
  90 ;;   `wesnoth-jump-backward', `wesnoth-jump-forward' to
  91 ;;   `wesnoth-indent-withtags-inline', `wesnoth-indent-default-inline' and
  92 ;;   `wesnoth-backward-tag', `wesnoth-forward-tag', respectively.
  93 ;; * Fixed a bug in indentation where content was needed between elements pairs
  94 ;;   for indentation to work.
  95 ;; * Fixed `wesnoth-newline-and-indent' ignoring the state of
  96 ;;   `wesnoth-auto-indent-flag'.
  97 ;; * Fixed `{...}' and `#endif' not font-locking correctly.
  98 ;; * Added indentation styles: `wesnoth-indent-default',
  99 ;;   `wesnoth-indent-withtags' which implement a a similar indentation
 100 ;;   style to the existing styles, however all preprocessor statements are
 101 ;;   indented to the first column.
 102 ;; * Added support for several new tags.
 103 ;; * Modified `wesnoth-newline' to behave more consistently.
 104 ;; * `wesnoth-jump-to-matching', `wesnoth-forward-tag', `wesnoth-backward-tag'
 105 ;;   now leaves point at the beginning (when moving backward) or end (when
 106 ;;   moving forward) of the match.
 107 ;; * `wesnoth-jump-to-matching' now attempts to find a target if necessary and
 108 ;;   will now work on preprocessor statements.  Will now warn if jump
 109 ;;   destination may not be correct (due to errors in WML structure).
 110 ;; * Indentation style is now determined by `wesnoth-indentation-function'.
 111 ;; * `wesnoth-check-structure' can now be applied over an active region and
 112 ;;   now checks preprocessor statements for correct nesting.
 113 ;; * `wesnoth-newline' and `wesnoth-newline-and-indent' can now be forced to
 114 ;;   perform indentation by providing a prefix argument.
 115 ;; * Indentation styles now leave point at the first non-whitespace character
 116 ;;   of the line.
 117 ;; * `wesnoth-check-tag-names' now reports on success.
 118 ;; * `wesnoth-insert-tag' is now able to insert tags around a region.
 119 ;; * `outline-minor-mode' now works on macro definitions.
 120 ;; 1.2.1
 121 ;; * Base indent now defaults to 4.
 122 ;; * Added support for #ifndef.
 123 \f
 124 ;;; Code:
 125 (require 'cl)
 126 (require 'wesnoth-wml-data)
 127 (require 'wesnoth-update)
 128
 129 (defconst wesnoth-mode-version "1.3.0-git"
 130   "The current version of `wesnoth-mode'.")
 131
 132 (defgroup wesnoth-mode nil "Wesnoth-mode access"
 133   :group 'languages
 134   :prefix "wesnoth-")
 135
 136 (defcustom wesnoth-auto-indent-flag t
 137   "Non-nil means indent the current line upon creating a newline."
 138   :type 'boolean
 139   :group 'wesnoth-mode)
 140
 141 (defcustom wesnoth-indent-savefile t
 142   "Non-nil means to use the current indentation conventions.
 143 If nil, use the old convention for indentation.
 144 The current convention is all attributes are indented a level deeper
 145 than their parent; in the past attributes were indented to the same
 146 level as their parent.")
 147
 148 (defcustom wesnoth-base-indent 4
 149   "The number of columns to indent WML."
 150   :type 'integer
 151   :group 'wesnoth-mode)
 152
 153 (defconst wesnoth-preprocessor-regexp
 154   "[\t ]*#\\(enddef\\|define \\|e\\(lse\\|nd\\(\\(de\\|i\\)f\\)\\)\\|\\(ifn?\\|un\\)def\\)"
 155   "Regular expression to match all preprocessor statements.")
 156
 157 (defconst wesnoth-preprocessor-opening-regexp
 158   "[\t ]*#\\(define \\|else\\|ifdef \\|ifndef \\)"
 159   "Regular expression to match \"opening\" preprocessor statements.")
 160
 161 (defconst wesnoth-preprocessor-closing-regexp
 162   "[\t ]*#\\(e\\(lse\\|nd\\(\\(de\\|i\\)f\\)\\)\\)"
 163   "Regular expression to match \"closing\" preprocessor statements.")
 164
 165 (defvar wesnoth-define-blocks '()
 166   "Cache of all toplevel #define and #enddef pairs.")
 167
 168 (defvar wesnoth-mode-hook nil)
 169
 170 (defvar wesnoth-mode-map
 171   (let ((map (make-sparse-keymap)))
 172     (define-key map (kbd "C-M-a") 'wesnoth-backward-element)
 173     (define-key map (kbd "C-M-e") 'wesnoth-forward-element)
 174     (define-key map (kbd "C-m") 'wesnoth-newline)
 175     (define-key map (kbd "C-j") 'wesnoth-newline-and-indent)
 176     (define-key map (kbd "C-c c") 'wesnoth-check-wml)
 177     (define-key map (kbd "C-c C-c") 'wesnoth-check-wml)
 178     (define-key map (kbd "C-c a") 'wesnoth-complete-attribute)
 179     (define-key map (kbd "C-c C-a") 'wesnoth-complete-attribute)
 180     (define-key map (kbd "C-c t") 'wesnoth-complete-tag)
 181     (define-key map (kbd "C-c C-t") 'wesnoth-complete-tag)
 182     (define-key map (kbd "M-TAB") 'wesnoth-insert-tag)
 183     (define-key map (kbd "C-c m") 'wesnoth-complete-macro)
 184     (define-key map (kbd "C-c C-m") 'wesnoth-complete-macro)
 185     (define-key map (kbd "C-c o") 'wesnoth-jump-to-matching)
 186     (define-key map (kbd "C-c C-o") 'wesnoth-jump-to-matching)
 187     (define-key map (kbd "C-c /") 'wesnoth-insert-missing-closing)
 188     (define-key map (kbd "C-c C-/") 'wesnoth-insert-missing-closing)
 189     (define-key map (kbd "TAB") 'wesnoth-indent-or-complete)
 190     (define-key map [menu-bar wesnoth]
 191       (cons "WML" (make-sparse-keymap "WML")))
 192     (define-key map [menu-bar wesnoth check-structure]
 193       '("Check WML" . wesnoth-check-wml))
 194     (define-key map [menu-bar wesnoth insert-tag]
 195       '("Insert Tag" . wesnoth-insert-tag))
 196     (define-key map [menu-bar wesnoth complete-attribute]
 197       '("Insert Attribute" . wesnoth-complete-attribute))
 198     (define-key map [menu-bar wesnoth complete-macro]
 199       '("Insert Macro" . wesnoth-complete-macro))
 200     (define-key map [menu-bar wesnoth jump-to-matching]
 201       '("Jump to Matching" . wesnoth-jump-to-matching))
 202     (define-key map [menu-bar wesnoth insert-missing-closing]
 203       '("Insert Missing Tag" . wesnoth-insert-missing-closing))
 204     map)
 205   "Keymap used in wesnoth mode.")
 206
 207 (defvar wesnoth-syntax-table
 208   (let ((wesnoth-syntax-table (make-syntax-table)))
 209     (modify-syntax-entry ?=  "." wesnoth-syntax-table)
 210     (modify-syntax-entry ?_ "_" wesnoth-syntax-table)
 211     (modify-syntax-entry ?-  "_" wesnoth-syntax-table)
 212     (modify-syntax-entry ?.  "_" wesnoth-syntax-table)
 213     (modify-syntax-entry ?\n ">" wesnoth-syntax-table)
 214     (modify-syntax-entry ?\r ">" wesnoth-syntax-table)
 215     wesnoth-syntax-table)
 216   "Syntax table for `wesnoth-mode'.")
 217
 218 ;; Prevents automatic syntax-highlighting of elements which might be
 219 ;; pre-processor statements.
 220 (defvar wesnoth-syntactic-keywords
 221   (list
 222    '("\\(^[\t ]*\\(#\\(?:define \\|e\\(?:lse\\|nd\\(?:\\(?:de\\|i\\)f\\)\\)\\|\\(?:ifn?\\|un\\)def \\)\\)\\|#enddef\\)" 1 "w")
 223    '("\\(#[\t ]*.*$\\)" 1 "<"))
 224   "Highlighting syntactic keywords within `wesnoth-mode'.")
 225
 226 (defun wesnoth-preprocessor-best-face ()
 227   "Use `font-lock-preprocessor-face' when available."
 228   (when global-font-lock-mode
 229     (if (boundp 'font-lock-preprocessor-face)
 230         (copy-face 'font-lock-preprocessor-face 'wesnoth-preprocessor-face)
 231       (copy-face 'font-lock-keyword-face 'wesnoth-preprocessor-face))))
 232
 233 (defvar wesnoth-font-lock-keywords
 234   (list
 235    '("#\\(?:define\\|\\(?:ifn?\\|un\\)def\\)" . 'wesnoth-preprocessor-face)
 236    '("\\(#\\(?:define\\|\\(?:ifn?\\|un\\)def\\)\\)[\t ]+\\(\\(\\w\\|_\\)+\\)"
 237      2 font-lock-function-name-face)
 238    '("\\(#e\\(?:lse\\|nd\\(?:\\(?:de\\|i\\)f\\)\\)\\)" .
 239      'wesnoth-preprocessor-face)
 240    '("\\({[@~]?\\(\\w\\|\\.\\|/\\|-\\)+}\\)"
 241      (1 font-lock-function-name-face))
 242    '("\\({\\(\\w\\|:\\|_\\)+\\|{[~@]?\\)"
 243      (1 font-lock-function-name-face))
 244    '("}" .  font-lock-function-name-face)
 245    '("^[\t ]*\\(\\[[^]]+\\]\\)" 1 font-lock-type-face)
 246    '("\\$\\(\\w\\|_\\)+" . font-lock-variable-name-face)
 247    '("\\(\\(\\w\\|_\\)+\\(\\,[\t ]*\\(\\w\\|_\\)+\\)*\\)="
 248      1 font-lock-variable-name-face))
 249   "Syntax highlighting for `wesnoth-mode'.")
 250
 251 (defconst wesnoth-element-closing "^[\t ]*\\(\\[/\\|#enddef\\)"
 252   "String to use for a closing element.")
 253
 254 (defconst wesnoth-element-opening "^[\t ]*\\(\\[[^/]\\|#define\\)"
 255   "String to use for an opening element.")
 256
 257 (defconst wesnoth-element "^[\t ]*\\(\\[[^]]?\\|#define\\|#enddef\\)"
 258   "String to use for an opening or closing element.")
 259 \f
 260 ;;; Insertion and completion
 261 (defun wesnoth-parent-tag ()
 262   "Return the name of the parent tag, nil otherwise."
 263   (save-excursion
 264     (let ((parent (when (> (point) (wesnoth-wml-start-pos))
 265                     (wesnoth-check-structure (wesnoth-wml-start-pos)
 266                                              (point)))))
 267       (when parent
 268         (if (string-match wesnoth-preprocessor-closing-regexp parent)
 269             t
 270           (subseq parent 2 (1- (length parent))))))))
 271
 272 (defun wesnoth-indent-or-complete ()
 273   "Indent or complete the line at point, depending on context."
 274   (interactive)
 275   (let ((target nil))
 276     (save-excursion
 277       (back-to-indentation)
 278       (cond ((looking-at "\\(\\(\\w\\|_\\)+\\)[\t ]*$")
 279              (wesnoth-complete-attribute))
 280             ((looking-at "\\[\\(\\(\\w\\|_\\)*\\)[\t ]*$")
 281              (wesnoth-complete-tag))
 282             ((looking-at "{\\(\\(\\w\\|_\\)*\\)[\t ]*$")
 283              (wesnoth-complete-macro))
 284             ((looking-at "\\[/\\(\\(\\w\\|_\\)*\\)[\t ]*$")
 285              (delete-region (point) (progn (end-of-line) (point)))
 286              (wesnoth-insert-missing-closing)
 287              (end-of-line))
 288             (t
 289              (wesnoth-indent)))
 290       (setq target (point)))
 291     (goto-char target)))
 292
 293 (defun wesnoth-complete-macro ()
 294   "Complete and insert the macro at point."
 295   (interactive)
 296   (wesnoth-update-project-information)
 297   (let* ((macro-information (append wesnoth-macro-data
 298                                     wesnoth-local-macro-data))
 299          (completions (wesnoth-emacs-completion-formats
 300                        (mapcar 'car macro-information)))
 301          (macro (wesnoth-element-completion completions "Macro: "))
 302          (args (second (find macro macro-information
 303                              :key 'car :test 'string=))))
 304     (when macro
 305       (delete-region (point) (progn (end-of-line) (point)))
 306       (insert (concat "{" macro (if args " }" "}")))
 307       (when args
 308         (forward-char -1)))))
 309
 310 (defun wesnoth-complete-attribute ()
 311   "Complete and insert the attribute at point."
 312   (interactive)
 313   (let* ((completions (wesnoth-build-completion 2))
 314          (partial (save-excursion
 315                     (back-to-indentation)
 316                     (looking-at "\\(\\(\\w\\|_\\)+\\)")
 317                     (match-string 1)))
 318          (attribute (or (wesnoth-element-completion completions "Attribute: ")
 319                         partial)))
 320     (when attribute
 321       (delete-region (point) (progn (end-of-line) (point)))
 322       (insert (concat attribute "=")))))
 323
 324 (defun wesnoth-complete-tag ()
 325   "Complete and insert the tag at point."
 326   (interactive)
 327   (let* ((completions (wesnoth-build-completion 1))
 328          (partial (save-excursion
 329                     (back-to-indentation)
 330                     (looking-at "\\[\\(\\(\\w\\|_\\)+\\)")
 331                     (match-string 1)))
 332          (tag (or (wesnoth-element-completion completions "Tag: ")
 333                   partial)))
 334     (let ((closed-p nil))
 335       (save-excursion
 336         (wesnoth-jump-to-matching)
 337           (back-to-indentation)
 338           (when (and (looking-at "\\[/\\(\\(\\w\\|_\\)+\\)")
 339                      (string= tag (match-string 1)))
 340             (setq closed-p t)))
 341       (delete-region (point) (progn (end-of-line) (point)))
 342       (if closed-p
 343           (progn
 344             (wesnoth-insert-and-indent "[" tag "]")
 345             (end-of-line))
 346         (wesnoth-insert-tag nil tag)))))
 347
 348 (defmacro wesnoth-element-completion (completions prompt)
 349   "Process completion of COMPLETIONS, displaying PROMPT."
 350   (let ((partial (gensym))
 351         (element (gensym)))
 352     `(let* ((,partial (match-string-no-properties 1))
 353             (,element (when ,partial (try-completion ,partial ,completions))))
 354        (cond ((eq ,element t)
 355               (setq ,element nil))
 356              ((null ,element)
 357               (setq ,element
 358                     (completing-read ,prompt ,completions)))
 359              ((not (member ,element ,completions))
 360               (setq ,element
 361                     (completing-read ,prompt ,completions
 362                                      nil nil ,partial))))
 363        ,element)))
 364
 365 (defun wesnoth-build-completion (position)
 366   "Create a new list for tag completion if necessary.
 367 Rebuilding list is required for versions of GNU Emacs earlier
 368 than 22.  POSITION is the argument passed to `nth' for
 369 `wesnoth-tag-data'."
 370   (interactive "P")
 371   (let* ((parent (wesnoth-parent-tag))
 372          (candidates
 373           (if (or (stringp parent) (null parent))
 374               (nth position (find (wesnoth-parent-tag) wesnoth-tag-data
 375                                   :key 'car :test 'string=))
 376             (mapcar 'car wesnoth-tag-data))))
 377     (wesnoth-emacs-completion-formats candidates)))
 378
 379 (defun wesnoth-emacs-completion-formats (candidates)
 380   "Return the completions in the correct format for `emacs-major-version'.
 381 CANDIDATES is a list of all possible completions."
 382   (if (> emacs-major-version 21)
 383       candidates
 384     (let ((tags '())
 385           (iter 0))
 386       (dolist (tag candidates)
 387         (setq iter (1+ iter))
 388         (setq tags (append tags (list (cons tag iter)))))
 389       tags)))
 390
 391 (defun wesnoth-insert-tag (&optional elements tagname)
 392   "Insert the specified opening tag and it's matching closing tag.
 393 Both the opening and closing tags will be placed on their own
 394 lines with point positioned between them.  Completion of tags at
 395 the prompt uses `wesnoth-tags-list'.
 396
 397 ELEMENTS is specifies the number of following blocks which the
 398 tag should wrap around.
 399
 400 TAGNAME is the name of the tag to be inserted."
 401   (interactive "Ps")
 402   (unless tagname
 403     (setq tagname (completing-read "Tag: " (wesnoth-build-completion 1))))
 404   (or elements (setq elements 0))
 405   (let ((depth 0)
 406         (start (save-excursion (forward-line -1) (point)))
 407         (end (unless (= elements 0)
 408                (wesnoth-nth-pair-position elements))))
 409     (wesnoth-insert-element-separately "[" tagname "]")
 410     (save-excursion
 411       (if end
 412           (goto-char (marker-position end))
 413         (newline 2))
 414       (wesnoth-insert-element-separately "[/" tagname "]")
 415       (indent-region start (point) nil))
 416     (unless end
 417       (forward-line 1)))
 418   (wesnoth-indent))
 419
 420 (defun wesnoth-nth-pair-position (count)
 421   "Return `point' after COUNT number of matching element pairs.
 422 COUNT is a positive number representing the number of balanced
 423 pairs to move across.
 424 `point' is returned as a marker object."
 425   (save-excursion
 426     (while (> count 0)
 427       ;; Currently looking-at target tag.  Stop here to avoid
 428       ;; incorrect nesting.
 429       (unless (wesnoth-search-for-matching-tag
 430                'search-forward-regexp wesnoth-element-closing 'point-max)
 431         (setq count 0)
 432         (search-backward-regexp wesnoth-element-closing (point-min) t))
 433       (and (> (decf count) 0) (forward-line 1)))
 434     (end-of-line)
 435     (point-marker)))
 436
 437 (defun wesnoth-insert-element-separately (&rest strings)
 438   "Concatenate STRINGS and insert them on a line of their own."
 439   (let ((create-newline  (save-excursion
 440                            (beginning-of-line)
 441                            (if (looking-at "^[\t ]*$") nil t))))
 442     (when create-newline
 443       (if (> (point) (save-excursion (back-to-indentation) (point)))
 444           (progn
 445             (end-of-line)
 446             (newline))
 447         (beginning-of-line)
 448         (open-line 1)))
 449     (insert (apply 'concat strings))))
 450
 451 (defun wesnoth-insert-missing-closing (&optional start end)
 452   "Insert the next expected closing element at point.
 453
 454 START and END define the region to check for missing closing
 455 elements.  If function `transient-mark-mode' is enabled, the region
 456 specified will be used as START and END.  Otherwise, START and
 457 END will be the minimum and maximum positions of the buffer,
 458 respectively."
 459   (interactive)
 460   (if (and transient-mark-mode mark-active)
 461       (setq start (region-beginning)
 462             end (copy-marker (region-end)))
 463     (setq start (point-min)
 464           end (point-max)))
 465   (let ((element (wesnoth-check-structure start end)))
 466     (if (not element)
 467         (error "%s" "Unable to find element to insert")
 468       (when (string= element "Unexpected end of file")
 469         (error "%s" element))
 470       (wesnoth-insert-element-separately element)))
 471   (wesnoth-indent)
 472   (end-of-line))
 473
 474 (defun wesnoth-insert-and-indent (&rest args)
 475   "Concatenate and insert the given string(s) before indenting.
 476
 477 ARGS is a list of strings to be inserted."
 478   (insert (apply 'concat args))
 479   (wesnoth-indent))
 480
 481 (defun wesnoth-newline (&optional indent)
 482   "Indent both the current line and the newline created.
 483 If `wesnoth-auto-indent-flag' is nil, indentation will not be
 484 performed.  Indentation can be forced by setting INDENT to
 485 non-nil."
 486   (interactive)
 487   (save-excursion
 488     (when (and (or wesnoth-auto-indent-flag indent)
 489                (not (looking-at "^[\t ]*$")))
 490       (wesnoth-indent)))
 491   (newline))
 492 \f
 493 ;;; Movement
 494 (defmacro wesnoth-navigate-element (repeat search-function bound)
 495   "Move point to the tag in the given direction REPEAT times.
 496
 497 SEARCH-FUNCTION is the symbol of the function for searching in
 498 the required direction, with BOUND marking the furthest point to
 499 search."
 500   `(progn
 501      (or ,repeat (setq ,repeat 1))
 502      (while (> ,repeat 0)
 503        (and (eq ,search-function 'search-forward-regexp) (end-of-line))
 504        (funcall ,search-function wesnoth-element-opening ,bound t)
 505        (back-to-indentation)
 506        (decf ,repeat))))
 507
 508 (defun wesnoth-forward-element (repeat)
 509   "Move point to the end of the next tag.
 510 REPEAT is an optional numeric argument.  If REPEAT is non-nil,
 511 jump forward the specified number of tags."
 512   (interactive "p")
 513   (if (< repeat 0)
 514       (wesnoth-backward-element (abs repeat))
 515     (wesnoth-navigate-element repeat 'search-forward-regexp (point-max))))
 516
 517 (defun wesnoth-backward-element (repeat)
 518   "Move point to the beginning of the previous tag.
 519 REPEAT is an optional numeric argument.  If REPEAT is non-nil,
 520 jump backward the specified number of tags."
 521   (interactive "p")
 522   (if (< repeat 0)
 523       (wesnoth-forward-element (abs repeat))
 524     (wesnoth-navigate-element repeat 'search-backward-regexp (point-min))))
 525
 526 (defmacro wesnoth-search-for-matching-tag (search-function search-string bound)
 527   "Search for the matching tag for the current line.
 528
 529 SEARCH-FUNCTION is the name of the function used to perform the search.
 530 SEARCH-STRING is a string representing the matching tag type.
 531 BOUND is the bound to be passed to the search function."
 532   `(let ((depth 1))
 533      (unless (looking-at ,search-string)
 534        (unless (> (point) (funcall ,bound)) (end-of-line))
 535        (while (and (> depth 0)
 536                    (funcall ,search-function wesnoth-element
 537                             (funcall ,bound) t))
 538          (if (string-match ,search-string (match-string 0))
 539              (decf depth)
 540            (incf depth)))
 541        t)))
 542
 543 (defun wesnoth-jump-to-matching ()
 544   "Jump point to the matching opening/closing tag."
 545   (interactive)
 546   (beginning-of-line)
 547   (if (looking-at wesnoth-element-opening)
 548       (wesnoth-search-for-matching-tag
 549        'search-forward-regexp wesnoth-element-closing 'point-max)
 550     (wesnoth-search-for-matching-tag
 551      'search-backward-regexp wesnoth-element-opening 'wesnoth-wml-start-pos))
 552   (back-to-indentation))
 553 \f
 554 (defun wesnoth-wml-start-pos ()
 555   "Determine the position of `point' relative to where the actual WML begins.
 556 Return the likely starting position of the WML if it is found.
 557 Otherwise return nil."
 558   (save-excursion
 559     (goto-char (point-min))
 560     (when (search-forward-regexp wesnoth-element (point-max) t)
 561       (beginning-of-line)
 562       (point))))
 563
 564 (defun first-column-indent-p (point)
 565   "Return non-nil if the current line should not be indented.
 566
 567 POINT is the position in the buffer to check.
 568 CONTEXT represents the type of element which precedes the current element."
 569   (or (not (wesnoth-wml-start-pos))
 570       (<= (point) (wesnoth-wml-start-pos))
 571       (nth 3 (parse-partial-sexp (point-min) point))
 572       (looking-at wesnoth-preprocessor-regexp)))
 573
 574 (defun wesnoth-indent ()
 575   "Indent the current line as WML."
 576   (beginning-of-line)
 577   (let ((cur-indent 0))
 578     (unless (first-column-indent-p (point))
 579       (multiple-value-bind (context ref-indent)
 580           (wesnoth-determine-context (point))
 581         (cond
 582          ((eq context 'opening)
 583           (if (or (and wesnoth-indent-savefile
 584                        (not (looking-at wesnoth-element-closing)))
 585                   (looking-at wesnoth-element-opening))
 586               (setq cur-indent (+ ref-indent wesnoth-base-indent))
 587             (setq cur-indent ref-indent)))
 588          ((eq context 'closing)
 589           (if (or (looking-at "^[\t ]*\\[/")
 590                   (and (not wesnoth-indent-savefile)
 591                        (not (looking-at wesnoth-element-opening))))
 592               (setq cur-indent (- ref-indent wesnoth-base-indent))
 593             (setq cur-indent ref-indent))))))
 594     (indent-line-to (max cur-indent 0))))
 595
 596 (defun wesnoth-within-define (position)
 597   "Determine whether point is currently inside a #define block.
 598 POSITION is the initial cursor position."
 599   (let ((depth 0))
 600     (dolist (element (or wesnoth-define-blocks
 601                          (wesnoth-find-macro-definitions)))
 602       (when (= (cadr (sort (append (mapcar 'marker-position (cadr element))
 603                                    (list position)) '>)) position)
 604         (setq depth (max (car element) depth))))
 605     depth))
 606
 607 (defun wesnoth-find-macro-definitions ()
 608   "Return information regarding positioning of macro definitions."
 609   (save-excursion
 610     (goto-char (point-min))
 611     (let ((depth 0)
 612           openings cache)
 613       (while (search-forward-regexp "^[\t ]*\\(#define\\|#enddef\\)" (point-max) t)
 614         (and (string= (match-string 1) "#define") (beginning-of-line))
 615         (setq depth
 616               (if (string= (match-string 1) "#define")
 617                   (progn
 618                     (add-to-list 'openings (point-marker))
 619                     (1+ depth))
 620                 (add-to-list 'cache
 621                              (list depth (list (car openings) (point-marker))))
 622                 (setq openings (cdr openings))
 623                 (1- depth)))
 624         (end-of-line))
 625       cache)))
 626
 627 (defun wesnoth-indent-region (start end)
 628   "Indent the region from START to END.
 629
 630 Creates and destroys a cache of macro definition details as necessary."
 631   (interactive "r")
 632   (unwind-protect
 633       (save-excursion
 634         (goto-char end)
 635         (setq end (point-marker))
 636         (goto-char start)
 637         (setq wesnoth-define-blocks (wesnoth-find-macro-definitions))
 638         (or (bolp) (forward-line 1))
 639         (while (< (point) end)
 640           (if (looking-at "^[\t ]*$")
 641               (indent-line-to 0)
 642             (funcall indent-line-function))
 643           (forward-line 1)))
 644     (setq wesnoth-define-blocks nil)))
 645
 646 (defun wesnoth-determine-context (position)
 647   "Determine the type of the last relevant element.
 648
 649 POSITION is the buffer position of the element for which to
 650 determine the context."
 651   (save-excursion
 652     (search-backward-regexp wesnoth-element (wesnoth-wml-start-pos) t)
 653     (let ((match (or (match-string 1) ""))
 654           (depth (wesnoth-within-define position)))
 655       (while (and (> (wesnoth-within-define (point)) depth)
 656                   (not (= (point) (wesnoth-wml-start-pos))))
 657         (search-backward-regexp wesnoth-element
 658                                 (wesnoth-wml-start-pos) t)
 659         (setq match (match-string 1)))
 660       (when (and (= (point) (wesnoth-wml-start-pos)) (= depth 0)
 661                  (string-match "#define" match))
 662         ;; Found nothing of use; reset match and assume top-level tag.
 663         (setq match ""))
 664       (cond
 665        ((string-match "\\[/\\|#enddef" match)
 666         (values 'closing (current-indentation)))
 667        ((string-match "\\[[^/]?\\|#define" match)
 668         (values 'opening (current-indentation)))))))
 669
 670 (defun wesnoth-newline-and-indent (&optional indent)
 671   "Indent both the current line and the newline created.
 672 If `wesnoth-auto-indent-flag' is nil, indentation will not be
 673 performed.
 674
 675 If the optional argument, INDENT is non-nil, force indentation to
 676 be performed."
 677   (interactive)
 678   (wesnoth-newline)
 679   (when (or wesnoth-auto-indent-flag indent)
 680     (wesnoth-indent)))
 681 \f
 682 ;;; WML checks
 683 (defun wesnoth-check-element-type (position last-tag)
 684   "Determine the context of the element.
 685 POSITION is the position of the element in the list.
 686 LAST-TAG is the parent element."
 687   (if (or (string= last-tag "#define")
 688           (string= last-tag "#ifndef")
 689           (string= last-tag "#ifdef"))
 690       (member (match-string-no-properties 1)
 691               (mapcar 'car wesnoth-tag-data))
 692     (member last-tag
 693             (mapcar 'car
 694                     (remove-if-not
 695                      (lambda (list)
 696                        (member (match-string-no-properties 1)
 697                                list))
 698                      wesnoth-tag-data :key position)))))
 699
 700 (defun wesnoth-check-output (buffer format-string &rest args)
 701   "Output the string as passed to `format'.
 702 BUFFER is the buffer to output the result.
 703 FORMAT-STRING is the string as the first argument of `format'.
 704 ARGS is any additional data required by `format' to handle FORMAT-STRING."
 705   (save-excursion
 706     (let ((lnap (line-number-at-pos)))
 707       (set-buffer buffer)
 708       (insert (apply 'format (concat "%d: " format-string "\n")
 709                      lnap args)))))
 710
 711 (defun wesnoth-check-wml ()
 712   "Perform context-sensitive analysis of WML-code."
 713   (interactive)
 714   (wesnoth-update-project-information)
 715   (let ((unmatched-tag-list '())
 716         (outbuf (get-buffer-create "*WML*")))
 717     (save-excursion
 718       (let ((buffer (buffer-name)))
 719         (set-buffer outbuf)
 720         (erase-buffer)
 721         (insert (format "Checking %s...\n" buffer))))
 722     (save-excursion
 723       (goto-char (or (wesnoth-wml-start-pos) (point-min)))
 724       (while (search-forward-regexp
 725               (concat "^[\t ]*\\(\\[[+/]?\\(\\(\\w\\|_\\)+\\)\\]\\|"
 726                       "\\(\\w\\|_\\)+=\\|{\\(\\(\\w\\|_\\)+\\).*}\\|"
 727                       wesnoth-preprocessor-regexp "\\)")
 728               (point-max) t)
 729         (beginning-of-line)
 730         (cond ((looking-at "^[\t ]*\\[\\+?\\(\\(\\w\\|_\\)+\\)\\]")
 731                (unless (wesnoth-check-element-type 'second
 732                                                    (car unmatched-tag-list))
 733                  (wesnoth-check-output outbuf
 734                                        "Tag not available in this context: %s"
 735                                        (match-string-no-properties 1)))
 736                (setq unmatched-tag-list (cons
 737                                          (match-string-no-properties 1)
 738                                          unmatched-tag-list)))
 739               ((looking-at "[\t ]*\\(#define\\|#ifdef\\|#ifndef\\) ")
 740                (setq unmatched-tag-list (cons (match-string-no-properties 1)
 741                                               unmatched-tag-list)))
 742               ((looking-at wesnoth-preprocessor-closing-regexp)
 743                (unless (string= (car unmatched-tag-list)
 744                                 (second (find (match-string-no-properties 1)
 745                                               '(("enddef" "#define")
 746                                                 ("ifdef" "#endif")
 747                                                 ("ifndef" "#endif"))
 748                                               :key 'car :test 'string=)))
 749                  (wesnoth-check-output outbuf
 750                   "Preprocessor statement does not nest correctly"))
 751                (setq unmatched-tag-list (cdr unmatched-tag-list)))
 752               ((looking-at "^[\t ]*\\(\\(\\w\\|_\\)+\\)=")
 753                (unless (wesnoth-check-element-type 'third
 754                                                    (car unmatched-tag-list))
 755                  (wesnoth-check-output
 756                   outbuf "Attribute not available in this context: %s"
 757                                        (match-string-no-properties 1))))
 758               ((looking-at "^[\t ]*#else")
 759                (unless (string-match "ifn?def" (car unmatched-tag-list))
 760                  (if (string= (car unmatched-tag-list) "#define")
 761                      (wesnoth-check-output outbuf "Expecting: %s"
 762                                            (car unmatched-tag-list))
 763                    (wesnoth-check-output outbuf "Expecting: [/%s]"
 764                                          (car unmatched-tag-list)))))
 765               ((looking-at "^[\t ]*{\\(\\(\\w\\|_\\)+\\).*}")
 766                (unless (find (match-string-no-properties 1)
 767                              (append wesnoth-local-macro-data
 768                                      wesnoth-macro-data)
 769                              :test 'string= :key 'car)
 770                  (wesnoth-check-output outbuf "Unknown macro definition: {%s}"
 771                                        (match-string-no-properties 1))))
 772               ((or (looking-at "^[\t ]*\\[/\\(\\(\\w\\|_\\)+\\)\\]"))
 773                (unless (string= (match-string-no-properties 1)
 774                                 (car unmatched-tag-list))
 775                  (if (string= "#" (subseq (car unmatched-tag-list) 0 1))
 776                      (wesnoth-check-output outbuf "Expecting: #%s"
 777                                            (car
 778                                             (find (car unmatched-tag-list)
 779                                                   '(("enddef" "#define")
 780                                                     ("ifdef" "#endif")
 781                                                     ("ifndef" "#endif"))
 782                                                   :key 'second :test 'string=)))
 783                    (wesnoth-check-output outbuf "Expecting: [/%s]"
 784                                          (car unmatched-tag-list))))
 785                (setq unmatched-tag-list (cdr unmatched-tag-list))))
 786         (end-of-line))
 787       (if unmatched-tag-list
 788           (dolist (tag unmatched-tag-list)
 789             (wesnoth-check-output outbuf "Unmatched tag: %s"
 790                                   (car unmatched-tag-list)))))
 791     (save-excursion
 792       (display-buffer outbuf t)
 793       (set-buffer outbuf)
 794       (insert (format "\nChecking complete.\n")))))
 795
 796 (defmacro wesnoth-element-requires (element requirement &optional pop)
 797   "Process requirements for corresponding preprocessor elements.
 798 ELEMENT is the current element being tested.
 799 REQUIREMENT is the element required to exist for correct nesting.
 800 POP is an optional argument indicating the element should be
 801 removed from the unmatched-tag-list."
 802   `(when (string= ,element (match-string-no-properties 1))
 803
 804      (if (string-match ,requirement (car unmatched-tag-list))
 805          (progn
 806            (and ,pop (setq unmatched-tag-list (cdr unmatched-tag-list)))
 807            t)
 808        (setq error-position (point)))))
 809
 810 (defmacro wesnoth-structure-result (position element)
 811   "Process results of the structure check.
 812 POSITION is the error position or nil, if no error was found.
 813 ELEMENT is the last unmatched element, or nil if all opening
 814 elements have been matched."
 815   `(let ((expected nil))
 816      (when ,element
 817        (cond ((string= ,element "define ") (setq expected "#enddef"))
 818              ((string-match "ifn?def " ,element) (setq expected "#endif"))))
 819      (if (interactive-p)
 820          (if (or ,element ,position)
 821              (progn
 822                (and ,position (goto-char ,position))
 823                (message "Error: Expecting %s" (or expected
 824                                                   (concat "[/" ,element "]"))))
 825            (message "%s" "Structure appears consistent."))
 826        (when (or expected ,element)
 827          (or expected (concat "[/" ,element "]"))))))
 828
 829 (defun wesnoth-check-structure (&optional start end)
 830   "Check the buffer for correct nesting of elements.
 831 If a problem is found in the structure, point will be placed at
 832 the location which an element was expected and the expected
 833 element will be displayed in the mini-buffer.
 834
 835 START and END define the region to be checked.  If
 836 function `transient-mark-mode' is enabled, the region specified will be
 837 checked.  Otherwise START and END will be the minimum and maximum
 838 positions of the buffer, respectively."
 839   (interactive)
 840   (unless (or start end)
 841     (if (and transient-mark-mode mark-active)
 842         (setq start (region-beginning)
 843               end (copy-marker (region-end)))
 844       (setq start (point-min)
 845             end (point-max))))
 846   (let ((unmatched-tag-list '())
 847         (error-position nil))
 848     (save-excursion
 849       (and start (goto-char start))
 850       (while (and (search-forward-regexp
 851                    (concat "^\\([\t ]*\\[\\(/?\\(\\w\\|_\\)+\\)\\]\\|"
 852                            wesnoth-preprocessor-regexp "\\)") end t)
 853                   (not error-position))
 854         (beginning-of-line)
 855         (if (or (looking-at "^[\t ]*\\[\\(\\(\\w\\|_\\)+\\)\\]")
 856                 (looking-at "[\t ]*#\\(define \\|ifdef \\|ifndef \\)"))
 857             (setq unmatched-tag-list (cons (match-string-no-properties 1)
 858                                            unmatched-tag-list))
 859           (cond
 860            ((wesnoth-element-requires "#else" "ifn?def "))
 861            ((wesnoth-element-requires "#endif" "ifn?def " t))
 862            ((wesnoth-element-requires "#enddef" "define " t))
 863            ((looking-at (concat "^[\t ]*\\[/\\(\\(\\w\\|_\\)+\\)\\]\\|"
 864                                 wesnoth-preprocessor-closing-regexp))
 865             (if (string= (match-string-no-properties 1)
 866                          (car unmatched-tag-list))
 867                 (setq unmatched-tag-list (cdr unmatched-tag-list))
 868               (setq error-position (point))))))
 869         (end-of-line)))
 870     (wesnoth-structure-result error-position (car unmatched-tag-list))))
 871 \f
 872 ;;; wesnoth-mode
 873 (define-derived-mode wesnoth-mode fundamental-mode "wesnoth-mode"
 874   "Major mode for editing WML."
 875   (wesnoth-preprocessor-best-face)
 876   (set-syntax-table wesnoth-syntax-table)
 877   (set (make-local-variable 'outline-regexp) "[\t ]*#define")
 878   (set (make-local-variable 'comment-start) "#")
 879   (set (make-local-variable 'indent-line-function) 'wesnoth-indent)
 880   (set (make-local-variable 'indent-region-function) 'wesnoth-indent-region)
 881   (set (make-local-variable 'font-lock-defaults)
 882        '(wesnoth-font-lock-keywords
 883          nil t nil nil
 884          (font-lock-syntactic-keywords . wesnoth-syntactic-keywords)))
 885   (setq indent-tabs-mode nil)
 886   (setq mode-name "WML")
 887   (run-hooks 'wesnoth-mode-hook))
 888
 889 (provide 'wesnoth-mode)
 890
 891 ;;; wesnoth-mode.el ends here