* wesnoth-mode.el (wesnoth-allow-accurate-validation): New custom variable.
authorChris Mann <chpln@internode.on.net>
Tue, 24 Mar 2009 01:45:43 +0000 (24 12:15 +1030)
committerChris Mann <chpln@internode.on.net>
Tue, 24 Mar 2009 01:45:43 +0000 (24 12:15 +1030)
  (wesnoth-found-cfgs): Moved from wesnoth-update.el.
  (wesnoth-find-previous): New function.
  (wesnoth-previous-element): New function.
  (wesnoth-parent-tag): Allow more precise parent detection.
  (wesnoth-check-element-type): Allow more precise parent detection.
  (wesnoth-check-output): Include buffer name in erorr.
  (wesnoth-check-wml): Support checking of multiple files.  Improve error
  messages.  Fix a bug where with window on the left would be incorrectly
  formatted.
  (wesnoth-check-directory): New command.
  (wesnoth-file-cfg-p, wesnoth-fetch-all-dirs, wesnoth-files-in-dir,
  wesnoth-cfg-files-in-dir): Moved from wesnoth-update.el.

* wesnoth-update.el (wesnoth-macro-directory): Removed.  No longer required.
  (wesnoth-file-cfg-p, wesnoth-fetch-all-dirs, wesnoth-files-in-dir,
  wesnoth-cfg-files-in-dir): Moved to wesnoth-mode.el.
  (wesnoth-determine-macro-information): Update docstring.
  (wesnoth-extract-tag-information): Also determine macro information.
  (wesnoth-update): Remove macro fetching -- performed elsewhere.

wesnoth-mode.el
wesnoth-update.el

index b8f0f5f..bc07b0c 100644 (file)
@@ -34,6 +34,9 @@
 
 ;;; History:
 ;; 1.3.5+git
+;; * Add support for WML validation on a directory.
+;; * Add support for more accurate WML validation. (See
+;;   `wesnoth-allow-accurate-validation'.)
 ;; * Improve and add support for prefix arg to `wesnoth-kill-block' to kill
 ;;   multiple blocks.
 ;; * Add support for attributes where whitespace is between the key and `='.
@@ -222,6 +225,16 @@ level as their parent.")
   :type 'integer
   :group 'wesnoth-mode)
 
+(defcustom wesnoth-allow-accurate-validation nil
+  "Whether to allow a more accurate method of WML validation.
+If non-nil, allow a more accurate method (which is able to better
+determine the current element's parent) to be used.  Note that
+this may cause WML validation to slow significantly when checking
+error-prone or messy WML.  If clean WML is generally used, it is
+recommended to set this to non-nil."
+  :type 'boolean
+  :group 'wesnoth-mode)
+
 (defconst wesnoth-preprocessor-regexp
   "[\t ]*#\\(enddef\\|define \\|e\\(lse\\|nd\\(\\(de\\|i\\)f\\)\\)\
 \\|\\(ifn?\\|un\\)def \\)"
@@ -244,6 +257,9 @@ level as their parent.")
 (defvar wesnoth-warning-markers '()
   "Markers for warnings in the buffer.")
 
+(defvar wesnoth-found-cfgs '()
+  "Temporary list of all .cfg files found.")
+
 (defvar wesnoth-mode-hook nil)
 
 (defface wesnoth-warning-face
@@ -406,6 +422,53 @@ Return non-nil when an element is found.  Otherwise, return nil."
          (search-forward "\"" (point-max) t))))
     details))
 
+(defun wesnoth-find-previous (type)
+  "Find the previous element of TYPE.
+TYPE is a symbol representing an element type, or a list of
+element types to find."
+  (let ((element (wesnoth-previous-element)))
+    (while (and element (if (listp type)
+                           (not (member (car element) type))
+                         (not (eq (car element) type))))
+      (setq element (wesnoth-previous-element)))
+    (when (if (listp type)
+             (member (car element) type)
+           (eq (car element) type))
+      element)))
+
+;; TODO: This is currently quite inefficient, and therefore is only used where
+;; necessary.  (i.e., when the parent element is initially may not be
+;; correctly detected.)
+(defun wesnoth-previous-element ()
+  "Move to the previous element in the buffer.
+Return non-nil when an element is found.  Otherwise, return nil."
+  (interactive)
+  (if (= (point) (wesnoth-wml-start-pos))
+    nil
+    (let ((init-element (save-excursion (wesnoth-next-element)))
+          last-element cur-element)
+      (save-match-data
+        (search-backward-regexp "\\(\\[\\+?\\(\\w\\|_\\)+\\]\\|#define\\|#ifn?def\\|\\(\\w\\|_\\)+[\t ]*=\\)" (point-min) t))
+      (while (< (cadr (setq cur-element (wesnoth-next-element)))
+                (cadr init-element))
+        (when (car cur-element)
+          (setq last-element cur-element)))
+      (goto-char (or (cadr last-element) (cadr init-element) (point-min))))
+  ;; Determine whether currently within a string, and move to its beginning
+  ;; where necessary.
+    (save-excursion
+      (let ((details (wesnoth-element-type (point))))
+        (save-match-data
+          (when (cadr details)
+            (goto-char (cadr details))
+            (while (nth 3 (parse-partial-sexp
+                           (save-excursion (search-backward-regexp
+                                            (wesnoth-element t) (point-min) t)
+                                           (point))
+                           (point)))
+              (search-backward "\"" (point-min) t))))
+        details))))
+
 (defun wesnoth-element-type (point)
   "Return details regarding the element at POINT.
 A list is returned, the elements of the list represent the
@@ -509,11 +572,12 @@ Finds the relevant parent tag, ignoring any conditional tags."
          (setq parent (wesnoth-parent-tag))))
       (car parent))))
 
-(defun wesnoth-parent-tag ()
+(defun wesnoth-parent-tag (&optional exact)
   "Return the name of the parent tag.
 If the parent is a preprocessor statement, return non-nil.
 If the element does not have a parent, return nil.
-Otherwise, return a string containing the name of the parent tag."
+Otherwise, return a string containing the name of the parent tag.
+If EXACT is non-nil a more accurate, yet slower method is used."
   (save-excursion
     (let ((start-point (point))
          (depth 1))
@@ -521,7 +585,10 @@ Otherwise, return a string containing the name of the parent tag."
                                              (point))))
        (end-of-line))
       (while (and (> depth 0)
-                 (search-backward-regexp (wesnoth-element t) (point-min) t))
+                  (if exact
+                      (wesnoth-find-previous
+                       '(tag-opening tag-closing preprocessor))
+                    (search-backward-regexp (wesnoth-element t) (point-min) t)))
        (if (string-match "[\t ]*\\[/\\|#enddef" (match-string 0))
            (setq depth (1+ depth))
          (setq depth (1- depth))))
@@ -1251,23 +1318,30 @@ be performed."
     (wesnoth-indent)))
 \f
 ;;; WML checks
-(defun wesnoth-check-element-type (position)
+(defun wesnoth-check-element-type (position &optional exact)
   "Determine the context of the element.
-POSITION is the position of the element in the list."
-  (let ((parent (save-match-data (car (wesnoth-parent-tag)))))
+POSITION is the position of the element in the list.  If EXACT is
+non-nil, a more accurate, yet slower method is used.  This is
+enabled when the attempt to match initially fails."
+  (let ((parent (save-match-data (car (wesnoth-parent-tag exact))))
+        (result '()))
     (if (or (stringp parent) (null parent))
-       (member (match-string-no-properties 1)
-               (nth position (gethash parent wesnoth-tag-hash-table)))
+       (setq result (member (match-string-no-properties 1)
+                             (nth position (gethash parent
+                                                    wesnoth-tag-hash-table))))
       (member (match-string-no-properties 1)
-             (let ((result '()))
-               (mapc
-                '(lambda (x)
-                   (let ((value (nth position (cdr x))))
-                     (and value (mapc '(lambda (y)
-                                         (setq result (cons y result)))
-                                      value))))
-                (or wesnoth-tmp-tag-data (wesnoth-refresh-wml-data)))
-               result)))))
+              (mapc
+               '(lambda (x)
+                  (let ((value (nth position (cdr x))))
+                    (and value (mapc '(lambda (y)
+                                        (setq result (cons y result)))
+                                     value))))
+               (or wesnoth-tmp-tag-data (wesnoth-refresh-wml-data)))))
+    ;; If unsuccessful and more accurate checking is available, use it.
+    ;; Otherwise, return the result found.
+    (if (and wesnoth-allow-accurate-validation (not exact) (not result))
+        (wesnoth-check-element-type position t)
+      result)))
 
 ;; Provide `line-number-at-pos' implementation (not available in Emacs 21).
 (defun wesnoth-line-number-at-pos (&optional pos)
@@ -1289,11 +1363,12 @@ BUFFER is the buffer to output the result.
 FORMAT-STRING is the string as the first argument of `format'.
 ARGS is any additional data required by `format' to handle FORMAT-STRING."
   (save-excursion
-    (let ((lnap (wesnoth-line-number-at-pos)))
+    (let ((lnap (wesnoth-line-number-at-pos))
+          (source-buffer (buffer-name)))
       (set-buffer buffer)
       (let ((buffer-read-only nil))
-       (insert (apply 'format (concat "Line %d: " format-string "\n")
-                      lnap args))))))
+       (insert (apply 'format (concat "%s: %d: " format-string "\n")
+                      source-buffer lnap args))))))
 
 (defun wesnoth-extract-macro-details (macro-arguments)
   "Return a list of all macros in MACRO-ARGUMENTS."
@@ -1525,8 +1600,10 @@ If ARG is not specifed, move backward one element."
   (when (looking-at (wesnoth-element-closing))
     (wesnoth-jump-to-matching)))
 
-(defun wesnoth-check-wml ()
-  "Perform context-sensitive analysis of WML-code."
+(defun wesnoth-check-wml (&optional preserve-buffer)
+  "Perform context-sensitive analysis of WML-code.
+If PRESERVE-BUFFER is non-nil, the contents of *WML* will be
+maintained through successive calls."
   (interactive)
   ;; Temporarily cache all tag-data.
   (setq wesnoth-tmp-tag-data (wesnoth-refresh-wml-data))
@@ -1540,7 +1617,8 @@ If ARG is not specifed, move backward one element."
     (error "WML data not available; unable to generate report"))
   (setq wesnoth-define-blocks (wesnoth-find-macro-definitions))
   (let ((unmatched '())
-       (outbuf (and (interactive-p) (get-buffer-create "*WML*")))
+        (source-buffer (buffer-name))
+       (outbuf (get-buffer-create "*WML*"))
        (last-match-pos 1)
        (details nil)
        (foreach '()))
@@ -1548,9 +1626,10 @@ If ARG is not specifed, move backward one element."
       (set-buffer outbuf)
       (let ((buffer (buffer-name))
            (buffer-read-only nil))
-       (erase-buffer)
-       (insert (format "Checking %s...\n" buffer))
-       (message (format "Checking %s..." buffer))))
+       (if preserve-buffer
+            (goto-char (point-max))
+          (erase-buffer))
+       (message (format "Checking %s..." source-buffer))))
     (save-excursion
       (goto-char (point-min))
       (while (setq details (wesnoth-find-next
@@ -1562,8 +1641,8 @@ If ARG is not specifed, move backward one element."
                 nil)
                ((eq (car details) 'macro)
                 (dolist (macro (save-match-data
-                                 (wesnoth-extract-macro-details
-                                  (match-string-no-properties 0))))
+                                  (wesnoth-extract-macro-details
+                                   (match-string-no-properties 0))))
                   (unless (assoc macro
                                  (wesnoth-merge-macro-data
                                   wesnoth-macro-data
@@ -1620,7 +1699,7 @@ If ARG is not specifed, move backward one element."
                ((looking-at "[\t ]*\\(\\(\\w\\|_\\)+\\)[\t ]*=\\(.+\\)?")
                 (unless (wesnoth-check-element-type 1)
                   (wesnoth-check-process
-                   "Attribute not available in this context: '%s'"
+                   "Key not available in this context: '%s'"
                    (match-string-no-properties 1)))
                 (unless (match-string 3)
                   (wesnoth-check-process
@@ -1651,19 +1730,76 @@ If ARG is not specifed, move backward one element."
       (when unmatched
        (dolist (element unmatched)
          (wesnoth-check-process "Unmatched element: '%s'" element))))
-    (save-excursion
-      (setq wesnoth-define-blocks nil
-           wesnoth-tmp-tag-data nil)
-      (set-buffer outbuf)
-      (toggle-read-only t)
-      (let ((buffer (buffer-name))
-           (buffer-read-only nil))
-       (display-buffer outbuf t)
-       (let ((warnings (- (wesnoth-line-number-at-pos
-                           (save-excursion (goto-char (point-max)))) 2)))
-         (insert (format (concat "\nCheck complete.  %d warning"
-                                 (if (= warnings 1) "." "s.")) warnings)))
-       (message (format "Checking %s...done" buffer))))))
+    (when (or (not preserve-buffer)
+              (and preserve-buffer (not (cdr wesnoth-found-cfgs))))
+      (save-excursion
+        (setq wesnoth-define-blocks nil
+              wesnoth-tmp-tag-data nil)
+        (set-buffer outbuf)
+        (toggle-read-only t)
+        (let ((buffer (buffer-name))
+              (buffer-read-only nil))
+          (display-buffer outbuf t)
+          (let ((warnings (- (wesnoth-line-number-at-pos
+                              (goto-char (point-max))) 1)))
+            (insert (format (concat "\nCheck complete.  %d warning"
+                                    (if (= warnings 1) "." "s.")) warnings)))
+          (message (format "Checking %s...done" source-buffer)))))))
+
+(defun wesnoth-check-directory (dir)
+  "Check all WML in DIR.
+Where DIR is a directory containing WML files."
+  (interactive "DDirectory: ")
+  (setq wesnoth-found-cfgs nil)
+  (when (member (mapcar 'buffer-name (buffer-list)) "*WML*")
+    (kill-buffer "*WML*"))
+  (wesnoth-fetch-all-dirs dir)
+  (let ((tmp-cfgs wesnoth-found-cfgs))
+    (while tmp-cfgs
+      (find-file (car wesnoth-found-cfgs))
+      (kill-buffer)
+      (setq tmp-cfgs (cdr tmp-cfgs))))
+  (save-excursion
+    (while wesnoth-found-cfgs
+      (find-file (car wesnoth-found-cfgs))
+      (wesnoth-check-wml t)
+      (kill-buffer)
+      (setq wesnoth-found-cfgs (cdr wesnoth-found-cfgs)))))
+
+(defun wesnoth-file-cfg-p (file)
+  "Return non-nil if FILE has a '.cfg' extension."
+  (and (not (file-directory-p file)) (string-match "\\.cfg$" file)))
+
+(defun wesnoth-fetch-all-dirs (dir)
+  "Retrieve a list of subdirectories to scan.
+DIR is the directory to check."
+  (let ((dirs-to-scan (wesnoth-files-in-dir dir)))
+    (while dirs-to-scan
+       (setq dirs-to-scan (append (wesnoth-files-in-dir (pop dirs-to-scan))
+                                  dirs-to-scan)))))
+
+(defun wesnoth-files-in-dir (dir)
+  "Add cfgs to `wesnoth-files-in-dir'.
+Returns a list of sub-directories in DIR."
+  (let ((cfgs (wesnoth-cfg-files-in-dir dir)))
+    (when cfgs
+      (setq wesnoth-found-cfgs (append cfgs wesnoth-found-cfgs))))
+  (let ((dirs '()))
+    (dolist (file (directory-files dir t))
+      (unless (string-match "^\\..*" (file-name-nondirectory file))
+       (cond ((file-directory-p file)
+              (add-to-list 'dirs file))
+             ((wesnoth-file-cfg-p file)
+              (add-to-list 'wesnoth-found-cfgs file)))))
+    dirs))
+
+(defun wesnoth-cfg-files-in-dir (dir)
+  "Return all cfg files in DIR."
+  (let ((result '()))
+    (dolist (file (directory-files dir t))
+      (and (wesnoth-file-cfg-p file)
+          (add-to-list 'result file)))
+    result))
 
 \f
 ;;; wesnoth-mode
index baf9d39..2a455ce 100644 (file)
@@ -60,6 +60,8 @@
 ;; available to `wesnoth-mode'.
 
 ;;; History:
+;; 0.1.5
+;; * `wesnoth-update' now finds more built-in macros.
 ;; 0.1.4
 ;; * Fixed inaccuracies when updating project information.
 ;; * WML data from the addition file can now read when as it is required.
@@ -96,13 +98,6 @@ Ensure this directory is in your `load-path'."
   :type 'directory
   :group 'wesnoth-mode)
 
-(defconst wesnoth-macro-directory "data/core/macros"
-  "Directory which built-in macros are stored.
-This is relative to the wesnoth directory in `wesnoth-root-directory.'.")
-
-(defvar wesnoth-found-cfgs '()
-  "Temporary list of all .cfg files found.")
-
 (defvar wesnoth-tmp-tag-data '()
   "Temporary list of tag data.")
 
@@ -133,41 +128,6 @@ any existing data."
     (dolist (tag tag-data)
       (puthash (car tag) (cdr tag) wesnoth-tag-hash-table))))
 
-(defun wesnoth-file-cfg-p (file)
-  "Return non-nil if FILE has a '.cfg' extension."
-  (and (not (file-directory-p file)) (string-match "\\.cfg$" file)))
-
-(defun wesnoth-fetch-all-dirs (dir)
-  "Retrieve a list of subdirectories to scan.
-DIR is the directory to check."
-  (let ((dirs-to-scan (wesnoth-files-in-dir dir)))
-    (while dirs-to-scan
-       (setq dirs-to-scan (append (wesnoth-files-in-dir (pop dirs-to-scan))
-                                  dirs-to-scan)))))
-
-(defun wesnoth-files-in-dir (dir)
-  "Add cfgs to `wesnoth-files-in-dir'.
-Returns a list of sub-directories in DIR."
-  (let ((cfgs (wesnoth-cfg-files-in-dir dir)))
-    (when cfgs
-      (setq wesnoth-found-cfgs (append cfgs wesnoth-found-cfgs))))
-  (let ((dirs '()))
-    (dolist (file (directory-files dir t))
-      (unless (string-match "^\\..*" (file-name-nondirectory file))
-       (cond ((file-directory-p file)
-              (add-to-list 'dirs file))
-             ((wesnoth-file-cfg-p file)
-              (add-to-list 'wesnoth-found-cfgs file)))))
-    dirs))
-
-(defun wesnoth-cfg-files-in-dir (dir)
-  "Return all cfg files in DIR."
-  (let ((result '()))
-    (dolist (file (directory-files dir t))
-      (and (wesnoth-file-cfg-p file)
-          (add-to-list 'result file)))
-    result))
-
 (defun wesnoth-determine-details (dir-or-file function)
   "Process .cfg files in DIR-OR-FILE using FUNCTION.
 DIR-OR-FILE can be a file, a directory, or a list of files."
@@ -196,6 +156,7 @@ DIR-OR-FILE can be a file, a directory, or a list of files."
   "Retrieve relevant tag and attribute information."
   (let ((unmatched-tag-list '()))
     (goto-char (point-min))
+    (wesnoth-determine-macro-information)
     (while (search-forward-regexp
            "^[\t ]*\\(\\[[+/]?\\(\\(\\w\\|_\\)+\\)\\]\\|\\(\\w\\|_\\)+=\\)"
            (point-max) t)
@@ -251,8 +212,7 @@ SUBTAG and ATTRIBUTE are a children of TAG to be added."
       (add-to-list 'wesnoth-tmp-tag-data match))))
 
 (defun wesnoth-determine-macro-information ()
-  "Process the buffer, retrieving macro definition information.
-MACRO-LIST is the variable to append macro information."
+  "Process the buffer, retrieving macro definition information."
   (save-excursion
     (goto-char (point-min))
     (while (search-forward-regexp
@@ -317,10 +277,6 @@ Path to WML information included in wesnoth is set by
   (message "Updating WML information...")
   (wesnoth-determine-details wesnoth-root-directory
                             'wesnoth-extract-tag-information)
-  (wesnoth-determine-details
-   (concat wesnoth-root-directory wesnoth-macro-directory)
-   (lambda ()
-     (wesnoth-determine-macro-information)))
   (setq wesnoth-tag-data wesnoth-tmp-tag-data
        wesnoth-tmp-tag-data nil
        wesnoth-macro-data wesnoth-tmp-macro-data