wesnoth-update.el

   1 ;;; wesnoth-update.el --- Update known WML data via existing valid WML.
   2 ;; Copyright (C) 2008 Chris Mann
   3
   4 ;; This file is part of wesnoth-mode.
   5
   6 ;; This program is free software; you can redistribute it and/or
   7 ;; modify it under the terms of the GNU General Public License as
   8 ;; published by the Free Software Foundation; either version 2 of the
   9 ;; License, or (at your option) any later version.
  10
  11 ;; This program is distributed in the hope that it will be useful, but
  12 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14 ;; General Public License for more details.
  15
  16 ;; You should have received a copy of the GNU General Public License
  17 ;; along with this program; see the file COPYING.  If not, write to the
  18 ;; Free Software Foundation, 51 Franklin Street, Fifth Floor, Boston,
  19 ;; MA 02139, USA.
  20
  21 ;;; Commentary:
  22 ;; Update WML information using WML built-in to Wesnoth.
  23 ;; The pathname of wesnoth must be set correctly for this to behave correctly,
  24 ;; for example:
  25 ;; (setq wesnoth-root-directory "/usr/share/wesnoth/")
  26 ;; Ensuring the pathname ends in a slash, then running `wesnoth-update'.
  27 ;; `wesnoth-update' will produce 'wesnoth-wml-data.el' in `default-directory',
  28 ;; ensure this file is in `load-path' to use the information retrieved in the
  29 ;; future sessions.
  30
  31 ;; Although much data is retreived, it is unlikely to be completely
  32 ;; comprehensive.  wesnoth-mode can be taught about additional tags,
  33 ;; attributes and macros using the current project, or a single file, using
  34 ;; `wesnoth-update-teach-wesnoth-mode'.
  35
  36 ;; To teach wesnoth-mode about elements it may have missed, you can create a
  37 ;; formatted WML file, ensuring the nesting and all elements are correct
  38 ;; (preferably by running wmllint) and evaluate:
  39 ;; (wesnoth-update-teach-wesnoth-mode "/path/to/structured/wml.cfg")
  40
  41 ;; It may be preferable to perform this each time wesnoth-mode is used.  For
  42 ;; this, you can add the following to your .emacs:
  43 ;; (add-hook 'wesnoth-mode-hook
  44 ;;   '(lambda ()
  45 ;;      (wesnoth-update-teach-wesnoth-mode "/path/to/structured/wml.cfg")))
  46
  47 ;;; History:
  48 ;; 0.1
  49 ;; * Initial version
  50 \f
  51 ;;; Code:
  52 (require 'cl)
  53
  54 (defvar wesnoth-update-version "0.1"
  55   "Version of `wesnoth-update'.")
  56 (defcustom wesnoth-root-directory nil
  57   "Path to the root directory of wesnoth.
  58 Path must end in trailing slash."
  59   :type 'directory
  60   :group 'wesnoth-mode)
  61
  62 (defvar wesnoth-macro-directory (concat wesnoth-root-directory "data/core/macros")
  63   "Directory which built-in macros are stored.
  64 This is relative to `wesnoth-root-directory'.")
  65
  66 (defvar wesnoth-found-cfgs '()
  67   "Temporary list of all .cfg files found.")
  68
  69 (defvar wesnoth-tag-data '()
  70   "All information regarding the relation of tags and attributes.")
  71
  72 (defvar wesnoth-macro-data '()
  73   "Information regarding built-in macros.")
  74
  75 (defvar wesnoth-local-macro-data '()
  76   "All macro definitions available in the current project.")
  77
  78 (defun wesnoth-file-cfg-p (file)
  79   "Return non-nil if FILE has a '.cfg' extension."
  80   (and (not (file-directory-p file)) (string-match "\\.cfg$" file)))
  81
  82 (defun wesnoth-fetch-all-dirs (dir)
  83   "Retrieve a list of subdirectories to scan.
  84 DIR is the directory to check."
  85   (let ((dirs-to-scan (wesnoth-files-in-dir dir)))
  86     (while dirs-to-scan
  87         (setq dirs-to-scan (append (wesnoth-files-in-dir (pop dirs-to-scan))
  88                                    dirs-to-scan)))))
  89
  90 (defun wesnoth-files-in-dir (dir)
  91   "Add cfgs to `wesnoth-files-in-dir'.
  92 Returns a list of sub-directories in dir."
  93   (let ((cfgs (wesnoth-cfg-files-in-dir dir)))
  94     (when cfgs
  95       (setq wesnoth-found-cfgs (append cfgs wesnoth-found-cfgs))))
  96   (remove-if
  97    (lambda (file)
  98      (or (not (file-directory-p file))
  99          (string-match "^\\..+" (file-name-nondirectory file))))
 100    (file-expand-wildcards (concat dir "/*") t)))
 101
 102 (defun wesnoth-cfg-files-in-dir (dir)
 103   "Return all cfg files in DIR."
 104   (remove-if-not 'wesnoth-file-cfg-p
 105                  (file-expand-wildcards
 106                   (concat dir "/*") t)))
 107
 108 (defun wesnoth-determine-details (dir-or-file function)
 109   "Process .cfg files in DIR-OR-FILE using FUNCTION.
 110 DIR-OR-FILE can be a file, a directory, or a list of files."
 111   (cond ((listp dir-or-file)
 112          (dolist (file dir-or-file)
 113            (wesnoth-handle-file function file)))
 114         ((and (file-exists-p dir-or-file)
 115               (not (file-directory-p dir-or-file)))
 116          (wesnoth-handle-file function dir-or-file))
 117         (t
 118          (wesnoth-fetch-all-dirs dir-or-file)
 119          (while wesnoth-found-cfgs
 120            (unless (string-match "^\\..+" (file-name-nondirectory
 121                                            (car wesnoth-found-cfgs)))
 122              (wesnoth-handle-file function (car wesnoth-found-cfgs))
 123              (setq wesnoth-found-cfgs (cdr wesnoth-found-cfgs)))))))
 124
 125 (defun wesnoth-handle-file (function file)
 126   "Perform FUNCTION on FILE."
 127   (with-temp-buffer
 128     (when (and (string-match "^\\.#.*" (file-name-nondirectory file))
 129                (file-symlink-p file))
 130       (setq file (concat (file-name-directory file)
 131                          (subseq (file-name-nondirectory file) 1) "#")))
 132     (insert-file-contents file)
 133     (funcall function)))
 134
 135 (defun wesnoth-extract-tag-information ()
 136   "Retrieve relevant tag and attribute information."
 137   (let ((unmatched-tag-list '()))
 138     (goto-char (point-min))
 139     (while (search-forward-regexp
 140             "^[\t ]*\\(\\[[+/]?\\(\\(\\w\\|_\\)+\\)\\]\\|\\(\\w\\|_\\)+=\\)"
 141             (point-max) t)
 142       (beginning-of-line)
 143       (cond ((looking-at "^[\t ]*\\[\\+?\\(\\(\\w\\|_\\)+\\)\\]")
 144              (wesnoth-append-tag-information (car unmatched-tag-list)
 145                                              (match-string-no-properties 1)
 146                                              nil)
 147              (setq unmatched-tag-list (cons (match-string-no-properties 1)
 148                                             unmatched-tag-list)))
 149             ((looking-at "^[\t ]*\\(\\(\\w\\|_\\)+\\)=")
 150              (wesnoth-append-tag-information (car unmatched-tag-list)
 151                                              nil (match-string-no-properties 1)))
 152             ((looking-at "^[\t ]*\\[/\\(\\(\\w\\|_\\)+\\)\\]\\|")
 153              (when (string= (match-string-no-properties 1)
 154                             (car unmatched-tag-list))
 155                (setq unmatched-tag-list (cdr unmatched-tag-list)))))
 156       (end-of-line))))
 157
 158 (defun wesnoth-append-tag-information (tag subtag attribute)
 159   "Add the information regarding TAG to the list.
 160 SUBTAG and ATTRIBUTE are a children of TAG to be added."
 161   (let ((match (find tag wesnoth-tag-data :key 'car :test 'string=)))
 162     (if (not match)
 163         (add-to-list 'wesnoth-tag-data (list tag nil nil))
 164       (if subtag
 165           (let ((tmp (nth 1 match)))
 166             (when (not (member subtag tmp))
 167               (add-to-list 'tmp subtag)
 168               (setq match (list tag tmp (car (last match))))))
 169         (when attribute (let ((tmp (nth 2 match)))
 170                           (when (not (member attribute tmp))
 171                             (add-to-list 'tmp attribute)
 172                             (setq match (list tag (nth 1 match) tmp))))))
 173       (setq wesnoth-tag-data
 174             (remove (find tag wesnoth-tag-data :key 'car :test 'string=)
 175                     wesnoth-tag-data))
 176       (add-to-list 'wesnoth-tag-data match))))
 177
 178 (defmacro wesnoth-determine-macro-information (macro-list)
 179   "Process the buffer, retrieving macro definition information.
 180 MACRO-LIST is the variable to append macro information."
 181   `(progn
 182      (goto-char (point-min))
 183      (while (search-forward-regexp
 184              "#define \\(\\(\\w\\|_\\)+\\)\\([\t ]+\\(\\w\\|_\\)+\\)?"
 185              (point-max) t)
 186        (beginning-of-line)
 187        (add-to-list ,macro-list (list (match-string 1)
 188                                       (when (match-string 3) t)))
 189        (end-of-line))))
 190
 191 (defun wesnoth-determine-macro-builtins ()
 192   "Retrieve built-in macro definition information."
 193   (wesnoth-determine-macro-information 'wesnoth-macro-data))
 194
 195 (defun wesnoth-update ()
 196   "Update WML information."
 197   (interactive)
 198   (setq wesnoth-tag-data nil
 199         wesnoth-macro-data nil)
 200   (unless wesnoth-root-directory
 201     (error "`wesnoth-root-directory' not a suitable pathname"))
 202   (wesnoth-determine-details wesnoth-root-directory 'wesnoth-extract-tag-information)
 203   (wesnoth-determine-details wesnoth-macro-directory 'wesnoth-determine-macro-builtins)
 204   (with-temp-buffer
 205     (insert (format "(defvar wesnoth-tag-data '%S)\n\n" wesnoth-tag-data))
 206     (insert (format "(defvar wesnoth-macro-data '%S)\n\n" wesnoth-macro-data))
 207     (insert (format "(provide 'wesnoth-wml-data)\n"))
 208     (write-file "wesnoth-wml-data.el")))
 209
 210 (defun wesnoth-update-project-information ()
 211   "Update WML macro information for the current project."
 212   (interactive)
 213   (wesnoth-determine-details (wesnoth-cfg-files-in-dir default-directory)
 214    (lambda ()
 215      (wesnoth-determine-macro-information 'wesnoth-local-macro-data))))
 216
 217 (defun wesnoth-update-teach-wesnoth-mode (file-or-dir)
 218   "Update WML tag and attribute information for the current project.
 219 If FILE-OR-DIR is provided, perform the update using only that location."
 220   (interactive)
 221   (wesnoth-determine-details
 222    file-or-dir
 223    (lambda ()
 224      (wesnoth-determine-macro-information 'wesnoth-macro-data)))
 225   (wesnoth-determine-details file-or-dir
 226                              'wesnoth-extract-tag-information))
 227
 228 (provide 'wesnoth-update)
 229
 230 ;;; wesnoth-update.el ends here