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-local-macro-data '()
 169   "All macro definitions available in the current project.")
 170
 171 (defvar wesnoth-mode-hook nil)
 172
 173 (defvar wesnoth-mode-map
 174   (let ((map (make-sparse-keymap)))
 175     (define-key map (kbd "C-M-a") 'wesnoth-backward-element)
 176     (define-key map (kbd "C-M-e") 'wesnoth-forward-element)
 177     (define-key map (kbd "C-m") 'wesnoth-newline)
 178     (define-key map (kbd "C-j") 'wesnoth-newline-and-indent)
 179     (define-key map (kbd "C-c c") 'wesnoth-check-wml)
 180     (define-key map (kbd "C-c C-c") 'wesnoth-check-wml)
 181     (define-key map (kbd "C-c a") 'wesnoth-complete-attribute)
 182     (define-key map (kbd "C-c C-a") 'wesnoth-complete-attribute)
 183     (define-key map (kbd "C-c t") 'wesnoth-complete-tag)
 184     (define-key map (kbd "C-c C-t") 'wesnoth-complete-tag)
 185     (define-key map (kbd "M-TAB") 'wesnoth-insert-tag)
 186     (define-key map (kbd "C-c m") 'wesnoth-complete-macro)
 187     (define-key map (kbd "C-c C-m") 'wesnoth-complete-macro)
 188     (define-key map (kbd "C-c o") 'wesnoth-jump-to-matching)
 189     (define-key map (kbd "C-c C-o") 'wesnoth-jump-to-matching)
 190     (define-key map (kbd "C-c /") 'wesnoth-insert-missing-closing)
 191     (define-key map (kbd "C-c C-/") 'wesnoth-insert-missing-closing)
 192     (define-key map (kbd "TAB") 'wesnoth-indent-or-complete)
 193     (define-key map [menu-bar wesnoth]
 194       (cons "WML" (make-sparse-keymap "WML")))
 195     (define-key map [menu-bar wesnoth check-structure]
 196       '("Check WML" . wesnoth-check-wml))
 197     (define-key map [menu-bar wesnoth insert-tag]
 198       '("Insert Tag" . wesnoth-insert-tag))
 199     (define-key map [menu-bar wesnoth complete-attribute]
 200       '("Insert Attribute" . wesnoth-complete-attribute))
 201     (define-key map [menu-bar wesnoth complete-macro]
 202       '("Insert Macro" . wesnoth-complete-macro))
 203     (define-key map [menu-bar wesnoth jump-to-matching]
 204       '("Jump to Matching" . wesnoth-jump-to-matching))
 205     (define-key map [menu-bar wesnoth insert-missing-closing]
 206       '("Insert Missing Tag" . wesnoth-insert-missing-closing))
 207     map)
 208   "Keymap used in wesnoth mode.")
 209
 210 (defvar wesnoth-syntax-table
 211   (let ((wesnoth-syntax-table (make-syntax-table)))
 212     (modify-syntax-entry ?=  "." wesnoth-syntax-table)
 213     (modify-syntax-entry ?_ "_" wesnoth-syntax-table)
 214     (modify-syntax-entry ?-  "_" wesnoth-syntax-table)
 215     (modify-syntax-entry ?.  "_" wesnoth-syntax-table)
 216     (modify-syntax-entry ?\n ">" wesnoth-syntax-table)
 217     (modify-syntax-entry ?\r ">" wesnoth-syntax-table)
 218     wesnoth-syntax-table)
 219   "Syntax table for `wesnoth-mode'.")
 220
 221 ;; Prevents automatic syntax-highlighting of elements which might be
 222 ;; pre-processor statements.
 223 (defvar wesnoth-syntactic-keywords
 224   (list
 225    '("\\(^[\t ]*\\(#\\(?:define \\|e\\(?:lse\\|nd\\(?:\\(?:de\\|i\\)f\\)\\)\\|\\(?:ifn?\\|un\\)def \\)\\)\\|#enddef\\)" 1 "w")
 226    '("\\(#[\t ]*.*$\\)" 1 "<"))
 227   "Highlighting syntactic keywords within `wesnoth-mode'.")
 228
 229 (defun wesnoth-preprocessor-best-face ()
 230   "Use `font-lock-preprocessor-face' when available."
 231   (when global-font-lock-mode
 232     (if (boundp 'font-lock-preprocessor-face)
 233         (copy-face 'font-lock-preprocessor-face 'wesnoth-preprocessor-face)
 234       (copy-face 'font-lock-keyword-face 'wesnoth-preprocessor-face))))
 235
 236 (defvar wesnoth-font-lock-keywords
 237   (list
 238    '("#\\(?:define\\|\\(?:ifn?\\|un\\)def\\)" . 'wesnoth-preprocessor-face)
 239    '("\\(#\\(?:define\\|\\(?:ifn?\\|un\\)def\\)\\)[\t ]+\\(\\(\\w\\|_\\)+\\)"
 240      2 font-lock-function-name-face)
 241    '("\\(#e\\(?:lse\\|nd\\(?:\\(?:de\\|i\\)f\\)\\)\\)" .
 242      'wesnoth-preprocessor-face)
 243    '("\\({[@~]?\\(\\w\\|\\.\\|/\\|-\\)+}\\)"
 244      (1 font-lock-function-name-face))
 245    '("\\({\\(\\w\\|:\\|_\\)+\\|{[~@]?\\)"
 246      (1 font-lock-function-name-face))
 247    '("}" .  font-lock-function-name-face)
 248    '("^[\t ]*\\(\\[[^]]+\\]\\)" 1 font-lock-type-face)
 249    '("\\$\\(\\w\\|_\\)+" . font-lock-variable-name-face)
 250    '("\\(\\(\\w\\|_\\)+\\(\\,[\t ]*\\(\\w\\|_\\)+\\)*\\)="
 251      1 font-lock-variable-name-face))
 252   "Syntax highlighting for `wesnoth-mode'.")
 253
 254 (defconst wesnoth-element-closing "^[\t ]*\\(\\[/\\|#enddef\\)"
 255   "String to use for a closing element.")
 256
 257 (defconst wesnoth-element-opening "^[\t ]*\\(\\[[^/]\\|#define\\)"
 258   "String to use for an opening element.")
 259
 260 (defconst wesnoth-element "^[\t ]*\\(\\[[^]]?\\|#define\\|#enddef\\)"
 261   "String to use for an opening or closing element.")
 262 \f
 263 ;;; Insertion and completion
 264 (defun wesnoth-parent-tag ()
 265   "Return the name of the parent tag, nil otherwise."
 266   (save-excursion
 267     (let ((parent (when (> (point) (wesnoth-wml-start-pos))
 268                     (wesnoth-check-structure (wesnoth-wml-start-pos)
 269                                              (point)))))
 270       (when parent
 271         (if (string-match wesnoth-preprocessor-closing-regexp parent)
 272             t
 273           (subseq parent 2 (1- (length parent))))))))
 274
 275 (defun wesnoth-indent-or-complete ()
 276   "Indent or complete the line at point, depending on context."
 277   (interactive)
 278   (let ((target nil))
 279     (save-excursion
 280       (back-to-indentation)
 281       (cond ((looking-at "\\(\\(\\w\\|_\\)+\\)[\t ]*$")
 282              (wesnoth-complete-attribute))
 283             ((looking-at "\\[\\(\\(\\w\\|_\\)*\\)[\t ]*$")
 284              (wesnoth-complete-tag))
 285             ((looking-at "{\\(\\(\\w\\|_\\)*\\)[\t ]*$")
 286              (wesnoth-complete-macro))
 287             ((looking-at "\\[/\\(\\(\\w\\|_\\)*\\)[\t ]*$")
 288              (delete-region (point) (progn (end-of-line) (point)))
 289              (wesnoth-insert-missing-closing)
 290              (end-of-line))
 291             (t
 292              (wesnoth-indent)))
 293       (setq target (point)))
 294     (goto-char target)))
 295
 296 (defun wesnoth-complete-macro ()
 297   "Complete and insert the macro at point."
 298   (interactive)
 299   (wesnoth-update-project-information)
 300   (let* ((macro-information (append wesnoth-macro-data
 301                                     wesnoth-local-macro-data))
 302          (completions (wesnoth-emacs-completion-formats
 303                        (mapcar 'car macro-information)))
 304          (macro (wesnoth-element-completion completions "Macro: "))
 305          (args (second (find macro macro-information
 306                              :key 'car :test 'string=))))
 307     (when macro
 308       (delete-region (point) (progn (end-of-line) (point)))
 309       (insert (concat "{" macro (if args " }" "}")))
 310       (when args
 311         (forward-char -1)))))
 312
 313 (defun wesnoth-complete-attribute ()
 314   "Complete and insert the attribute at point."
 315   (interactive)
 316   (let* ((completions (wesnoth-build-completion 2))
 317          (partial (save-excursion
 318                     (back-to-indentation)
 319                     (looking-at "\\(\\(\\w\\|_\\)+\\)")
 320                     (match-string 1)))
 321          (attribute (or (wesnoth-element-completion completions "Attribute: ")
 322                         partial)))
 323     (when attribute
 324       (delete-region (point) (progn (end-of-line) (point)))
 325       (insert (concat attribute "=")))))
 326
 327 (defun wesnoth-complete-tag ()
 328   "Complete and insert the tag at point."
 329   (interactive)
 330   (let* ((completions (wesnoth-build-completion 1))
 331          (partial (save-excursion
 332                     (back-to-indentation)
 333                     (looking-at "\\[\\(\\(\\w\\|_\\)+\\)")
 334                     (match-string 1)))
 335          (tag (or (wesnoth-element-completion completions "Tag: ")
 336                   partial)))
 337     (let ((closed-p nil))
 338       (save-excursion
 339         (wesnoth-jump-to-matching)
 340           (back-to-indentation)
 341           (when (and (looking-at "\\[/\\(\\(\\w\\|_\\)+\\)")
 342                      (string= tag (match-string 1)))
 343             (setq closed-p t)))
 344       (delete-region (point) (progn (end-of-line) (point)))
 345       (if closed-p
 346           (progn
 347             (wesnoth-insert-and-indent "[" tag "]")
 348             (end-of-line))
 349         (wesnoth-insert-tag nil tag)))))
 350
 351 (defmacro wesnoth-element-completion (completions prompt)
 352   "Process completion of COMPLETIONS, displaying PROMPT."
 353   (let ((partial (gensym))
 354         (element (gensym)))
 355     `(let* ((,partial (match-string-no-properties 1))
 356             (,element (when ,partial (try-completion ,partial ,completions))))
 357        (cond ((eq ,element t)
 358               (setq ,element nil))
 359              ((null ,element)
 360               (setq ,element
 361                     (completing-read ,prompt ,completions)))
 362              ((not (member ,element ,completions))
 363               (setq ,element
 364                     (completing-read ,prompt ,completions
 365                                      nil nil ,partial))))
 366        ,element)))
 367
 368 (defun wesnoth-build-completion (position)
 369   "Create a new list for tag completion if necessary.
 370 Rebuilding list is required for versions of GNU Emacs earlier
 371 than 22.  POSITION is the argument passed to `nth' for
 372 `wesnoth-tag-data'."
 373   (interactive "P")
 374   (let* ((parent (wesnoth-parent-tag))
 375          (candidates
 376           (if (or (stringp parent) (null parent))
 377               (nth position (find (wesnoth-parent-tag) wesnoth-tag-data
 378                                   :key 'car :test 'string=))
 379             (mapcar 'car wesnoth-tag-data))))
 380     (wesnoth-emacs-completion-formats candidates)))
 381
 382 (defun wesnoth-emacs-completion-formats (candidates)
 383   "Return the completions in the correct format for `emacs-major-version'.
 384 CANDIDATES is a list of all possible completions."
 385   (if (> emacs-major-version 21)
 386       candidates
 387     (let ((tags '())
 388           (iter 0))
 389       (dolist (tag candidates)
 390         (setq iter (1+ iter))
 391         (setq tags (append tags (list (cons tag iter)))))
 392       tags)))
 393
 394 (defun wesnoth-insert-tag (&optional elements tagname)
 395   "Insert the specified opening tag and it's matching closing tag.
 396 Both the opening and closing tags will be placed on their own
 397 lines with point positioned between them.  Completion of tags at
 398 the prompt uses `wesnoth-tags-list'.
 399
 400 ELEMENTS is specifies the number of following blocks which the
 401 tag should wrap around.
 402
 403 TAGNAME is the name of the tag to be inserted."
 404   (interactive "Ps")
 405   (unless tagname
 406     (setq tagname (completing-read "Tag: " (wesnoth-build-completion 1))))
 407   (or elements (setq elements 0))
 408   (let ((depth 0)
 409         (start (save-excursion (forward-line -1) (point)))
 410         (end (unless (= elements 0)
 411                (wesnoth-nth-pair-position elements))))
 412     (wesnoth-insert-element-separately "[" tagname "]")
 413     (save-excursion
 414       (if end
 415           (goto-char (marker-position end))
 416         (newline 2))
 417       (wesnoth-insert-element-separately "[/" tagname "]")
 418       (indent-region start (point) nil))
 419     (unless end
 420       (forward-line 1)))
 421   (wesnoth-indent))
 422
 423 (defun wesnoth-nth-pair-position (count)
 424   "Return `point' after COUNT number of matching element pairs.
 425 COUNT is a positive number representing the number of balanced
 426 pairs to move across.
 427 `point' is returned as a marker object."
 428   (save-excursion
 429     (while (> count 0)
 430       ;; Currently looking-at target tag.  Stop here to avoid
 431       ;; incorrect nesting.
 432       (unless (wesnoth-search-for-matching-tag
 433                'search-forward-regexp wesnoth-element-closing 'point-max)
 434         (setq count 0)
 435         (search-backward-regexp wesnoth-element-closing (point-min) t))
 436       (and (> (decf count) 0) (forward-line 1)))
 437     (end-of-line)
 438     (point-marker)))
 439
 440 (defun wesnoth-insert-element-separately (&rest strings)
 441   "Concatenate STRINGS and insert them on a line of their own."
 442   (let ((create-newline  (save-excursion
 443                            (beginning-of-line)
 444                            (if (looking-at "^[\t ]*$") nil t))))
 445     (when create-newline
 446       (if (> (point) (save-excursion (back-to-indentation) (point)))
 447           (progn
 448             (end-of-line)
 449             (newline))
 450         (beginning-of-line)
 451         (open-line 1)))
 452     (insert (apply 'concat strings))))
 453
 454 (defun wesnoth-insert-missing-closing (&optional start end)
 455   "Insert the next expected closing element at point.
 456
 457 START and END define the region to check for missing closing
 458 elements.  If function `transient-mark-mode' is enabled, the region
 459 specified will be used as START and END.  Otherwise, START and
 460 END will be the minimum and maximum positions of the buffer,
 461 respectively."
 462   (interactive)
 463   (if (and transient-mark-mode mark-active)
 464       (setq start (region-beginning)
 465             end (copy-marker (region-end)))
 466     (setq start (point-min)
 467           end (point-max)))
 468   (let ((element (wesnoth-check-structure start end)))
 469     (if (not element)
 470         (error "%s" "Unable to find element to insert")
 471       (when (string= element "Unexpected end of file")
 472         (error "%s" element))
 473       (wesnoth-insert-element-separately element)))
 474   (wesnoth-indent)
 475   (end-of-line))
 476
 477 (defun wesnoth-insert-and-indent (&rest args)
 478   "Concatenate and insert the given string(s) before indenting.
 479
 480 ARGS is a list of strings to be inserted."
 481   (insert (apply 'concat args))
 482   (wesnoth-indent))
 483
 484 (defun wesnoth-newline (&optional indent)
 485   "Indent both the current line and the newline created.
 486 If `wesnoth-auto-indent-flag' is nil, indentation will not be
 487 performed.  Indentation can be forced by setting INDENT to
 488 non-nil."
 489   (interactive)
 490   (save-excursion
 491     (when (and (or wesnoth-auto-indent-flag indent)
 492                (not (looking-at "^[\t ]*$")))
 493       (wesnoth-indent)))
 494   (newline))
 495 \f
 496 ;;; Movement
 497 (defmacro wesnoth-navigate-element (repeat search-function bound)
 498   "Move point to the tag in the given direction REPEAT times.
 499
 500 SEARCH-FUNCTION is the symbol of the function for searching in
 501 the required direction, with BOUND marking the furthest point to
 502 search."
 503   `(progn
 504      (or ,repeat (setq ,repeat 1))
 505      (while (> ,repeat 0)
 506        (and (eq ,search-function 'search-forward-regexp) (end-of-line))
 507        (funcall ,search-function wesnoth-element-opening ,bound t)
 508        (back-to-indentation)
 509        (decf ,repeat))))
 510
 511 (defun wesnoth-forward-element (repeat)
 512   "Move point to the end of the next tag.
 513 REPEAT is an optional numeric argument.  If REPEAT is non-nil,
 514 jump forward the specified number of tags."
 515   (interactive "p")
 516   (if (< repeat 0)
 517       (wesnoth-backward-element (abs repeat))
 518     (wesnoth-navigate-element repeat 'search-forward-regexp (point-max))))
 519
 520 (defun wesnoth-backward-element (repeat)
 521   "Move point to the beginning of the previous tag.
 522 REPEAT is an optional numeric argument.  If REPEAT is non-nil,
 523 jump backward the specified number of tags."
 524   (interactive "p")
 525   (if (< repeat 0)
 526       (wesnoth-forward-element (abs repeat))
 527     (wesnoth-navigate-element repeat 'search-backward-regexp (point-min))))
 528
 529 (defmacro wesnoth-search-for-matching-tag (search-function search-string bound)
 530   "Search for the matching tag for the current line.
 531
 532 SEARCH-FUNCTION is the name of the function used to perform the search.
 533 SEARCH-STRING is a string representing the matching tag type.
 534 BOUND is the bound to be passed to the search function."
 535   `(let ((depth 1))
 536      (unless (looking-at ,search-string)
 537        (unless (> (point) (funcall ,bound)) (end-of-line))
 538        (while (and (> depth 0)
 539                    (funcall ,search-function wesnoth-element
 540                             (funcall ,bound) t))
 541          (if (string-match ,search-string (match-string 0))
 542              (decf depth)
 543            (incf depth)))
 544        t)))
 545
 546 (defun wesnoth-jump-to-matching ()
 547   "Jump point to the matching opening/closing tag."
 548   (interactive)
 549   (beginning-of-line)
 550   (if (looking-at wesnoth-element-opening)
 551       (wesnoth-search-for-matching-tag
 552        'search-forward-regexp wesnoth-element-closing 'point-max)
 553     (wesnoth-search-for-matching-tag
 554      'search-backward-regexp wesnoth-element-opening 'wesnoth-wml-start-pos))
 555   (back-to-indentation))
 556 \f
 557 (defun wesnoth-wml-start-pos ()
 558   "Determine the position of `point' relative to where the actual WML begins.
 559 Return the likely starting position of the WML if it is found.
 560 Otherwise return nil."
 561   (save-excursion
 562     (goto-char (point-min))
 563     (when (search-forward-regexp wesnoth-element (point-max) t)
 564       (beginning-of-line)
 565       (point))))
 566
 567 (defun first-column-indent-p (point)
 568   "Return non-nil if the current line should not be indented.
 569
 570 POINT is the position in the buffer to check.
 571 CONTEXT represents the type of element which precedes the current element."
 572   (or (not (wesnoth-wml-start-pos))
 573       (<= (point) (wesnoth-wml-start-pos))
 574       (nth 3 (parse-partial-sexp (point-min) point))
 575       (looking-at wesnoth-preprocessor-regexp)))
 576
 577 (defun wesnoth-indent ()
 578   "Indent the current line as WML."
 579   (beginning-of-line)
 580   (let ((cur-indent 0))
 581     (unless (first-column-indent-p (point))
 582       (multiple-value-bind (context ref-indent)
 583           (wesnoth-determine-context (point))
 584         (cond
 585          ((eq context 'opening)
 586           (if (or (and wesnoth-indent-savefile
 587                        (not (looking-at wesnoth-element-closing)))
 588                   (looking-at wesnoth-element-opening))
 589               (setq cur-indent (+ ref-indent wesnoth-base-indent))
 590             (setq cur-indent ref-indent)))
 591          ((eq context 'closing)
 592           (if (or (looking-at "^[\t ]*\\[/")
 593                   (and (not wesnoth-indent-savefile)
 594                        (not (looking-at wesnoth-element-opening))))
 595               (setq cur-indent (- ref-indent wesnoth-base-indent))
 596             (setq cur-indent ref-indent))))))
 597     (indent-line-to (max cur-indent 0))))
 598
 599 (defun wesnoth-within-define (position)
 600   "Determine whether point is currently inside a #define block.
 601 POSITION is the initial cursor position."
 602   (let ((depth 0))
 603     (dolist (element (or wesnoth-define-blocks
 604                          (wesnoth-find-macro-definitions)))
 605       (when (= (cadr (sort (append (mapcar 'marker-position (cadr element))
 606                                    (list position)) '>)) position)
 607         (setq depth (max (car element) depth))))
 608     depth))
 609
 610 (defun wesnoth-find-macro-definitions ()
 611   "Return information regarding positioning of macro definitions."
 612   (save-excursion
 613     (goto-char (point-min))
 614     (let ((depth 0)
 615           openings cache)
 616       (while (search-forward-regexp "^[\t ]*\\(#define\\|#enddef\\)" (point-max) t)
 617         (and (string= (match-string 1) "#define") (beginning-of-line))
 618         (setq depth
 619               (if (string= (match-string 1) "#define")
 620                   (progn
 621                     (add-to-list 'openings (point-marker))
 622                     (1+ depth))
 623                 (add-to-list 'cache
 624                              (list depth (list (car openings) (point-marker))))
 625                 (setq openings (cdr openings))
 626                 (1- depth)))
 627         (end-of-line))
 628       cache)))
 629
 630 (defun wesnoth-indent-region (start end)
 631   "Indent the region from START to END.
 632
 633 Creates and destroys a cache of macro definition details as necessary."
 634   (interactive "r")
 635   (unwind-protect
 636       (save-excursion
 637         (goto-char end)
 638         (setq end (point-marker))
 639         (goto-char start)
 640         (setq wesnoth-define-blocks (wesnoth-find-macro-definitions))
 641         (or (bolp) (forward-line 1))
 642         (while (< (point) end)
 643           (if (looking-at "^[\t ]*$")
 644               (indent-line-to 0)
 645             (funcall indent-line-function))
 646           (forward-line 1)))
 647     (setq wesnoth-define-blocks nil)))
 648
 649 (defun wesnoth-determine-context (position)
 650   "Determine the type of the last relevant element.
 651
 652 POSITION is the buffer position of the element for which to
 653 determine the context."
 654   (save-excursion
 655     (search-backward-regexp wesnoth-element (wesnoth-wml-start-pos) t)
 656     (let ((match (or (match-string 1) ""))
 657           (depth (wesnoth-within-define position)))
 658       (while (and (> (wesnoth-within-define (point)) depth)
 659                   (not (= (point) (wesnoth-wml-start-pos))))
 660         (search-backward-regexp wesnoth-element
 661                                 (wesnoth-wml-start-pos) t)
 662         (setq match (match-string 1)))
 663       (when (and (= (point) (wesnoth-wml-start-pos)) (= depth 0)
 664                  (string-match "#define" match))
 665         ;; Found nothing of use; reset match and assume top-level tag.
 666         (setq match ""))
 667       (cond
 668        ((string-match "\\[/\\|#enddef" match)
 669         (values 'closing (current-indentation)))
 670        ((string-match "\\[[^/]?\\|#define" match)
 671         (values 'opening (current-indentation)))))))
 672
 673 (defun wesnoth-newline-and-indent (&optional indent)
 674   "Indent both the current line and the newline created.
 675 If `wesnoth-auto-indent-flag' is nil, indentation will not be
 676 performed.
 677
 678 If the optional argument, INDENT is non-nil, force indentation to
 679 be performed."
 680   (interactive)
 681   (wesnoth-newline)
 682   (when (or wesnoth-auto-indent-flag indent)
 683     (wesnoth-indent)))
 684 \f
 685 ;;; WML checks
 686 (defun wesnoth-check-element-type (position last-tag)
 687   "Determine the context of the element.
 688 POSITION is the position of the element in the list.
 689 LAST-TAG is the parent element."
 690   (if (or (string= last-tag "#define")
 691           (string= last-tag "#ifndef")
 692           (string= last-tag "#ifdef"))
 693       (member (match-string-no-properties 1)
 694               (mapcar 'car wesnoth-tag-data))
 695     (member last-tag
 696             (mapcar 'car
 697                     (remove-if-not
 698                      (lambda (list)
 699                        (member (match-string-no-properties 1)
 700                                list))
 701                      wesnoth-tag-data :key position)))))
 702
 703 (defun wesnoth-check-output (buffer format-string &rest args)
 704   "Output the string as passed to `format'.
 705 BUFFER is the buffer to output the result.
 706 FORMAT-STRING is the string as the first argument of `format'.
 707 ARGS is any additional data required by `format' to handle FORMAT-STRING."
 708   (save-excursion
 709     (let ((lnap (line-number-at-pos)))
 710       (set-buffer buffer)
 711       (insert (apply 'format (concat "%d: " format-string "\n")
 712                      lnap args)))))
 713
 714 (defun wesnoth-check-wml ()
 715   "Perform context-sensitive analysis of WML-code."
 716   (interactive)
 717   (wesnoth-update-project-information)
 718   (let ((unmatched-tag-list '())
 719         (outbuf (get-buffer-create "*WML*")))
 720     (save-excursion
 721       (let ((buffer (buffer-name)))
 722         (set-buffer outbuf)
 723         (erase-buffer)
 724         (insert (format "Checking %s...\n" buffer))))
 725     (save-excursion
 726       (goto-char (or (wesnoth-wml-start-pos) (point-min)))
 727       (while (search-forward-regexp
 728               (concat "^[\t ]*\\(\\[[+/]?\\(\\(\\w\\|_\\)+\\)\\]\\|"
 729                       "\\(\\w\\|_\\)+=\\|{\\(\\(\\w\\|_\\)+\\).*}\\|"
 730                       wesnoth-preprocessor-regexp "\\)")
 731               (point-max) t)
 732         (beginning-of-line)
 733         (cond ((looking-at "^[\t ]*\\[\\+?\\(\\(\\w\\|_\\)+\\)\\]")
 734                (unless (wesnoth-check-element-type 'second
 735                                                    (car unmatched-tag-list))
 736                  (wesnoth-check-output outbuf
 737                                        "Tag not available in this context: %s"
 738                                        (match-string-no-properties 1)))
 739                (setq unmatched-tag-list (cons
 740                                          (match-string-no-properties 1)
 741                                          unmatched-tag-list)))
 742               ((looking-at "[\t ]*\\(#define\\|#ifdef\\|#ifndef\\) ")
 743                (setq unmatched-tag-list (cons (match-string-no-properties 1)
 744                                               unmatched-tag-list)))
 745               ((looking-at wesnoth-preprocessor-closing-regexp)
 746                (unless (string= (car unmatched-tag-list)
 747                                 (second (find (match-string-no-properties 1)
 748                                               '(("enddef" "#define")
 749                                                 ("ifdef" "#endif")
 750                                                 ("ifndef" "#endif"))
 751                                               :key 'car :test 'string=)))
 752                  (wesnoth-check-output outbuf
 753                   "Preprocessor statement does not nest correctly"))
 754                (setq unmatched-tag-list (cdr unmatched-tag-list)))
 755               ((looking-at "^[\t ]*\\(\\(\\w\\|_\\)+\\)=")
 756                (unless (wesnoth-check-element-type 'third
 757                                                    (car unmatched-tag-list))
 758                  (wesnoth-check-output
 759                   outbuf "Attribute not available in this context: %s"
 760                                        (match-string-no-properties 1))))
 761               ((looking-at "^[\t ]*#else")
 762                (unless (string-match "ifn?def" (car unmatched-tag-list))
 763                  (if (string= (car unmatched-tag-list) "#define")
 764                      (wesnoth-check-output outbuf "Expecting: %s"
 765                                            (car unmatched-tag-list))
 766                    (wesnoth-check-output outbuf "Expecting: [/%s]"
 767                                          (car unmatched-tag-list)))))
 768               ((looking-at "^[\t ]*{\\(\\(\\w\\|_\\)+\\).*}")
 769                (unless (find (match-string-no-properties 1)
 770                              (append wesnoth-local-macro-data
 771                                      wesnoth-macro-data)
 772                              :test 'string= :key 'car)
 773                  (wesnoth-check-output outbuf "Unknown macro definition: {%s}"
 774                                        (match-string-no-properties 1))))
 775               ((or (looking-at "^[\t ]*\\[/\\(\\(\\w\\|_\\)+\\)\\]"))
 776                (unless (string= (match-string-no-properties 1)
 777                                 (car unmatched-tag-list))
 778                  (if (string= "#" (subseq (car unmatched-tag-list) 0 1))
 779                      (wesnoth-check-output outbuf "Expecting: #%s"
 780                                            (car
 781                                             (find (car unmatched-tag-list)
 782                                                   '(("enddef" "#define")
 783                                                     ("ifdef" "#endif")
 784                                                     ("ifndef" "#endif"))
 785                                                   :key 'second :test 'string=)))
 786                    (wesnoth-check-output outbuf "Expecting: [/%s]"
 787                                          (car unmatched-tag-list))))
 788                (setq unmatched-tag-list (cdr unmatched-tag-list))))
 789         (end-of-line))
 790       (if unmatched-tag-list
 791           (dolist (tag unmatched-tag-list)
 792             (wesnoth-check-output outbuf "Unmatched tag: %s"
 793                                   (car unmatched-tag-list)))))
 794     (save-excursion
 795       (display-buffer outbuf t)
 796       (set-buffer outbuf)
 797       (insert (format "\nChecking complete.\n")))))
 798
 799 (defmacro wesnoth-element-requires (element requirement &optional pop)
 800   "Process requirements for corresponding preprocessor elements.
 801 ELEMENT is the current element being tested.
 802 REQUIREMENT is the element required to exist for correct nesting.
 803 POP is an optional argument indicating the element should be
 804 removed from the unmatched-tag-list."
 805   `(when (string= ,element (match-string-no-properties 1))
 806
 807      (if (string-match ,requirement (car unmatched-tag-list))
 808          (progn
 809            (and ,pop (setq unmatched-tag-list (cdr unmatched-tag-list)))
 810            t)
 811        (setq error-position (point)))))
 812
 813 (defmacro wesnoth-structure-result (position element)
 814   "Process results of the structure check.
 815 POSITION is the error position or nil, if no error was found.
 816 ELEMENT is the last unmatched element, or nil if all opening
 817 elements have been matched."
 818   `(let ((expected nil))
 819      (when ,element
 820        (cond ((string= ,element "define ") (setq expected "#enddef"))
 821              ((string-match "ifn?def " ,element) (setq expected "#endif"))))
 822      (if (interactive-p)
 823          (if (or ,element ,position)
 824              (progn
 825                (and ,position (goto-char ,position))
 826                (message "Error: Expecting %s" (or expected
 827                                                   (concat "[/" ,element "]"))))
 828            (message "%s" "Structure appears consistent."))
 829        (when (or expected ,element)
 830          (or expected (concat "[/" ,element "]"))))))
 831
 832 (defun wesnoth-check-structure (&optional start end)
 833   "Check the buffer for correct nesting of elements.
 834 If a problem is found in the structure, point will be placed at
 835 the location which an element was expected and the expected
 836 element will be displayed in the mini-buffer.
 837
 838 START and END define the region to be checked.  If
 839 function `transient-mark-mode' is enabled, the region specified will be
 840 checked.  Otherwise START and END will be the minimum and maximum
 841 positions of the buffer, respectively."
 842   (interactive)
 843   (unless (or start end)
 844     (if (and transient-mark-mode mark-active)
 845         (setq start (region-beginning)
 846               end (copy-marker (region-end)))
 847       (setq start (point-min)
 848             end (point-max))))
 849   (let ((unmatched-tag-list '())
 850         (error-position nil))
 851     (save-excursion
 852       (and start (goto-char start))
 853       (while (and (search-forward-regexp
 854                    (concat "^\\([\t ]*\\[\\(/?\\(\\w\\|_\\)+\\)\\]\\|"
 855                            wesnoth-preprocessor-regexp "\\)") end t)
 856                   (not error-position))
 857         (beginning-of-line)
 858         (if (or (looking-at "^[\t ]*\\[\\(\\(\\w\\|_\\)+\\)\\]")
 859                 (looking-at "[\t ]*#\\(define \\|ifdef \\|ifndef \\)"))
 860             (setq unmatched-tag-list (cons (match-string-no-properties 1)
 861                                            unmatched-tag-list))
 862           (cond
 863            ((wesnoth-element-requires "#else" "ifn?def "))
 864            ((wesnoth-element-requires "#endif" "ifn?def " t))
 865            ((wesnoth-element-requires "#enddef" "define " t))
 866            ((looking-at (concat "^[\t ]*\\[/\\(\\(\\w\\|_\\)+\\)\\]\\|"
 867                                 wesnoth-preprocessor-closing-regexp))
 868             (if (string= (match-string-no-properties 1)
 869                          (car unmatched-tag-list))
 870                 (setq unmatched-tag-list (cdr unmatched-tag-list))
 871               (setq error-position (point))))))
 872         (end-of-line)))
 873     (wesnoth-structure-result error-position (car unmatched-tag-list))))
 874 \f
 875 ;;; wesnoth-mode
 876 (define-derived-mode wesnoth-mode fundamental-mode "wesnoth-mode"
 877   "Major mode for editing WML."
 878   (wesnoth-preprocessor-best-face)
 879   (set-syntax-table wesnoth-syntax-table)
 880   (set (make-local-variable 'outline-regexp) "[\t ]*#define")
 881   (set (make-local-variable 'comment-start) "#")
 882   (set (make-local-variable 'indent-line-function) 'wesnoth-indent)
 883   (set (make-local-variable 'indent-region-function) 'wesnoth-indent-region)
 884   (set (make-local-variable 'font-lock-defaults)
 885        '(wesnoth-font-lock-keywords
 886          nil t nil nil
 887          (font-lock-syntactic-keywords . wesnoth-syntactic-keywords)))
 888   (setq indent-tabs-mode nil)
 889   (setq mode-name "WML")
 890   (run-hooks 'wesnoth-mode-hook))
 891
 892 (provide 'wesnoth-mode)
 893
 894 ;;; wesnoth-mode.el ends here