4 files changed, 191 insertions, 125 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 09e0349e7f1..de2b79577e1 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2013-08-07  Arni Magnusson  <arnima@hafro.is>
+
+        * progmodes/dos.el: New file.
+        * generic-x.el (bat-generic-mode): Redefine as an obsolete alias to
+        dos-mode.
+
 2013-08-06  Glenn Morris  <rgm@gnu.org>
 
         * calendar/calendar.el: Add new faces, and day-header-array.
diff --git a/lisp/generic-x.el b/lisp/generic-x.el
index 1867759b549..698819d73a1 100644
--- a/lisp/generic-x.el
+++ b/lisp/generic-x.el
@@ -460,130 +460,7 @@ like an INI file.  You can add this hook to `find-file-hook'."
 
 ;;; DOS/Windows BAT files
 (when (memq 'bat-generic-mode generic-extras-enable-list)
-
-(define-generic-mode bat-generic-mode
-  nil
-  nil
-  (eval-when-compile
-    (list
-     ;; Make this one first in the list, otherwise comments will
-     ;; be over-written by other variables
-     '("^[@ \t]*\\([rR][eE][mM][^\n\r]*\\)" 1 font-lock-comment-face t)
-     '("^[ \t]*\\(::.*\\)"                  1 font-lock-comment-face t)
-     '("^[@ \t]*\\([bB][rR][eE][aA][kK]\\|[vV][eE][rR][iI][fF][yY]\\)[ \t]+\\([oO]\\([nN]\\|[fF][fF]\\)\\)"
-       (1 font-lock-builtin-face)
-       (2 font-lock-constant-face t t))
-     ;; Any text (except ON/OFF) following ECHO is a string.
-     '("^[@ \t]*\\([eE][cC][hH][oO]\\)[ \t]+\\(\\([oO]\\([nN]\\|[fF][fF]\\)\\)\\|\\([^>|\r\n]+\\)\\)"
-       (1 font-lock-builtin-face)
-       (3 font-lock-constant-face t t)
-       (5 font-lock-string-face t t))
-     ;; These keywords appear as the first word on a line.  (Actually, they
-     ;; can also appear after "if ..." or "for ..." clause, but since they
-     ;; are frequently used in simple text, we punt.)
-     ;; In `generic-bat-mode-setup-function' we make the keywords
-     ;; case-insensitive
-     '("^[@ \t]*\\_<\\(for\\|if\\)\\_>" 1 font-lock-keyword-face)
-     ;; These keywords can be anywhere on a line
-     ;; In `generic-bat-mode-setup-function' we make the keywords
-     ;; case-insensitive
-     (list (regexp-opt '("do" "exist" "errorlevel" "goto" "not") 'symbols)
-           1 font-lock-keyword-face)
-     ;; These are built-in commands.  Only frequently-used ones are listed.
-     (list (concat "[ \t|\n]"
-                   (regexp-opt '("CALL"     "call"       "Call"
-                                 "CD"       "cd"         "Cd"
-                                 "CLS"      "cls"        "Cls"
-                                 "COPY"     "copy"       "Copy"
-                                 "DEL"      "del"        "Del"
-                                 "ECHO"     "echo"       "Echo"
-                                 "MD"       "md"         "Md"
-                                 "PATH"     "path"       "Path"
-                                 "PAUSE"    "pause"      "Pause"
-                                 "PROMPT"   "prompt"     "Prompt"
-                                 "RD"       "rd"         "Rd"
-                                 "REN"      "ren"        "Ren"
-                                 "SET"      "set"        "Set"
-                                 "START"    "start"      "Start"
-                                 "SHIFT"    "shift"      "Shift") 'symbols))
-           1 font-lock-builtin-face)
-     '("^[ \t]*\\(:\\sw+\\)"         1 font-lock-function-name-face t)
-     '("\\(%\\sw+%\\)"               1 font-lock-variable-name-face t)
-     '("\\(%[0-9]\\)"                1 font-lock-variable-name-face t)
-     '("[\t ]+\\([+-/][^\t\n\" ]+\\)" 1 font-lock-type-face)
-     '("[ \t\n|]\\<\\([gG][oO][tT][oO]\\)\\>[ \t]*\\(\\sw+\\)?"
-       (1 font-lock-keyword-face)
-       (2 font-lock-function-name-face nil t))
-     '("[ \t\n|]\\<\\([sS][eE][tT]\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*=?"
-       (1 font-lock-builtin-face)
-       (2 font-lock-variable-name-face t t))))
-  '("\\.[bB][aA][tT]\\'"
-    "\\.[cC][mM][dD]\\'"
-    "\\`[cC][oO][nN][fF][iI][gG]\\."
-    "\\`[aA][uU][tT][oO][eE][xX][eE][cC]\\.")
-  '(generic-bat-mode-setup-function)
-  "Generic mode for MS-Windows batch files.")
-
-(defvar bat-generic-mode-syntax-table nil
-  "Syntax table in use in `bat-generic-mode' buffers.")
-
-(defvar bat-generic-mode-keymap (make-sparse-keymap)
-  "Keymap for `bat-generic-mode'.")
-
-(defun bat-generic-mode-compile ()
-  "Run the current BAT file in a compilation buffer."
-  (interactive)
-  (let ((compilation-buffer-name-function
-         (function
-          (lambda (_ign)
-            (concat "*" (buffer-file-name) "*")))))
-    (compile
-     (concat (w32-shell-name) " -c " (buffer-file-name)))))
-
-(declare-function comint-mode "comint" ())
-(declare-function comint-exec "comint" (buffer name command startfile switches))
-
-(defun bat-generic-mode-run-as-comint ()
-  "Run the current BAT file in a comint buffer."
-  (interactive)
-  (require 'comint)
-  (let* ((file (buffer-file-name))
-         (buf-name (concat "*" file "*")))
-    (with-current-buffer (get-buffer-create buf-name)
-      (erase-buffer)
-      (comint-mode)
-      (comint-exec
-       buf-name
-       file
-       (w32-shell-name)
-       nil
-       (list "-c" file))
-      (display-buffer buf-name))))
-
-(define-key bat-generic-mode-keymap "\C-c\C-c" 'bat-generic-mode-compile)
-
-;; Make underscores count as words
-(unless bat-generic-mode-syntax-table
-  (setq bat-generic-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?_ "w" bat-generic-mode-syntax-table))
-
-;; bat-generic-mode doesn't use the comment functionality of
-;; define-generic-mode because it has a three-letter comment-string,
-;; so we do it here manually instead
-(defun generic-bat-mode-setup-function ()
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (make-local-variable 'comment-start)
-  (make-local-variable 'comment-start-skip)
-  (make-local-variable 'comment-end)
-  (setq imenu-generic-expression '((nil "^:\\(\\sw+\\)" 1))
-        parse-sexp-ignore-comments t
-        comment-end ""
-        comment-start "REM "
-        comment-start-skip "[Rr][Ee][Mm] *")
-  (set-syntax-table bat-generic-mode-syntax-table)
-  ;; Make keywords case-insensitive
-  (setq font-lock-defaults '(generic-font-lock-keywords nil t))
-  (use-local-map bat-generic-mode-keymap)))
+  (define-obsolete-function-alias 'bat-generic-mode 'dos-mode "24.4"))
 
 ;;; Mailagent
 ;; Mailagent is a Unix mail filtering program.  Anyone wanna do a
diff --git a/lisp/progmodes/dos.el b/lisp/progmodes/dos.el
new file mode 100644
index 00000000000..57b137f97fb
--- /dev/null
+++ b/lisp/progmodes/dos.el
@@ -0,0 +1,183 @@
+;;; dos.el --- Major mode for editing Dos scripts
+
+;; Copyright (C) 2003, 2008-2013 Free Software Foundation, Inc.
+
+;; Author: Arni Magnusson <arnima@hafro.is>
+;; Keywords: languages
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Major mode for editing Dos scripts (batch files). Provides syntax
+;; highlighting, a basic template, access to Dos help pages, imenu/outline
+;; navigation, and the ability to run scripts from within Emacs. The syntax
+;; groups for highlighting are:
+;;
+;; Face                          Example
+;; dos-label-face                :LABEL
+;; font-lock-comment-face        rem
+;; font-lock-builtin-face        copy
+;; font-lock-keyword-face        goto
+;; font-lock-warning-face        cp
+;; font-lock-constant-face       [call] prog
+;; font-lock-variable-name-face  %var%
+;; font-lock-type-face           -option
+;;
+;; Usage:
+;;
+;; See documentation of function `dos-mode'.
+;;
+;; Separate package `dos-indent' (Matthew Fidler) provides rudimentary
+;; indentation, see http://www.emacswiki.org/emacs/dos-indent.el.
+;;
+;; Acknowledgements:
+;;
+;; Inspired by `batch-mode' (Agnar Renolen) and `cmd-mode' (Tadamegu Furukawa).
+
+;;; Code:
+
+;; 1  Preamble
+
+(defgroup dos nil
+  "Major mode for editing Dos scripts."
+  :link '(custom-group-link :tag "Font Lock Faces group" font-lock-faces)
+  :group 'languages)
+
+;; 2  User variables
+
+(defface dos-label-face '((t :weight bold))
+  "Font Lock mode face used to highlight Dos labels."
+  :group 'dos)
+
+;; 3  Internal variables
+
+(defvar dos-font-lock-keywords
+  (eval-when-compile
+    (let ((COMMANDS
+           '("assoc" "at" "attrib" "cd" "cls" "color" "copy" "date" "del" "dir"
+             "doskey" "echo" "endlocal" "erase" "fc" "find" "findstr" "format"
+             "ftype" "label" "md" "mkdir" "more" "move" "net" "path" "pause"
+             "popd" "prompt" "pushd" "rd" "ren" "rename" "replace" "rmdir" "set"
+             "setlocal" "shift" "sort" "subst" "time" "title" "tree" "type"
+             "ver" "vol" "xcopy"))
+          (CONTROLFLOW
+           '("call" "cmd" "defined" "do" "else" "equ" "exist" "exit" "for" "geq"
+             "goto" "gtr" "if" "in" "leq" "lss" "neq" "not" "start"))
+          (LINUX
+           '("cat" "cp" "ls" "mv" "rm")))
+      (list
+       '("\\<\\(call\\|goto\\)\\>[ \t]+%?\\([A-Za-z0-9-_\\:.]+\\)%?"
+         (2 font-lock-constant-face t))
+       '("^[ \t]*\\(@?rem\\>\\|::\\).*"
+         (0 font-lock-comment-face t))
+       '("^:[^:].*"
+         . 'dos-label-face)
+       '("\\<\\(defined\\|set\\)\\>[ \t]*\\(\\w+\\)"
+         (2 font-lock-variable-name-face))
+       '("%\\(\\w+\\)%?"
+         (1 font-lock-variable-name-face))
+       '("!\\(\\w+\\)!?" ; delayed-expansion !variable!
+         (1 font-lock-variable-name-face))
+       '("[ =][-/]+\\(\\w+\\)"
+         (1 font-lock-type-face append))
+       (cons (regexp-opt COMMANDS 'words) font-lock-builtin-face)
+       (cons (regexp-opt CONTROLFLOW 'words) font-lock-keyword-face)
+       (cons (regexp-opt LINUX 'words) font-lock-warning-face)))))
+
+(defvar dos-menu
+  '("Dos"
+    ["Run" dos-run :help "Run script"]
+    ["Run with Args" dos-run-args :help "Run script with args"]
+    "--"
+    ["Imenu" imenu :help "Navigate with imenu"]
+    "--"
+    ["Template" dos-template :help "Insert template"]
+    "--"
+    ["Help (Command)" dos-cmd-help :help "Show help page for Dos command"]
+    ["Help (Mode)" dos-mode-help :help "Show help page for Emacs Dos Mode"]))
+
+(defvar dos-mode-map
+  (let ((map (make-sparse-keymap)))
+    (easy-menu-define nil map nil dos-menu)
+    (define-key map [?\C-c ?\C-.] 'dos-mode-help)
+    (define-key map [?\C-c ?\C-/] 'dos-cmd-help)
+    (define-key map [?\C-c ?\C-a] 'dos-run-args)
+    (define-key map [?\C-c ?\C-c] 'dos-run)
+    (define-key map [?\C-c ?\C-t] 'dos-template)
+    (define-key map [?\C-c ?\C-v] 'dos-run)
+    map))
+
+(defvar dos-mode-syntax-table
+  (let ((table (make-syntax-table)))
+    (modify-syntax-entry ?~ "w" table)
+    (modify-syntax-entry ?% "." table)
+    (modify-syntax-entry ?- "w" table)
+    (modify-syntax-entry ?_ "w" table)
+    (modify-syntax-entry ?{ "w" table)
+    (modify-syntax-entry ?} "w" table)
+    (modify-syntax-entry ?\\ "." table)
+    table))
+
+;; 4  User functions
+
+(defun dos-cmd-help (cmd)
+  "Show help for Dos command."
+  (interactive "sHelp: ")
+  (if (string-equal cmd "net")
+      (shell-command "net /?") (shell-command (concat "help " cmd))))
+
+(defun dos-mode-help ()
+  "Show help page for `dos-mode'."
+  (interactive)
+  (describe-function 'dos-mode)
+  (switch-to-buffer "*Help*") (delete-other-windows) (message nil))
+
+(defun dos-run ()
+  "Run Dos script."
+  (interactive)
+  (save-buffer) (shell-command buffer-file-name))
+
+(defun dos-run-args (args)
+  "Run Dos script with ARGS."
+  (interactive "sArgs: ")
+  (shell-command (concat buffer-file-name " " args)))
+
+(defun dos-template ()
+  "Insert minimal Dos template."
+  (interactive)
+  (goto-char (point-min)) (insert "@echo off\nsetlocal\n\n"))
+
+;; 5  Main function
+
+;;;###autoload
+(define-derived-mode dos-mode prog-mode "Dos"
+  "Major mode for editing Dos scripts.\n
+The `dos-mode-help' command shows this page.\n
+Start a new script from `dos-template'. Read help pages for Dos commands with
+`dos-cmd-help'. Navigate between sections using `imenu'. Run script using
+`dos-run' and `dos-run-args'.\n
+\\{dos-mode-map}"
+  (set (make-local-variable 'comment-start) "rem")
+  (set (make-local-variable 'font-lock-defaults)
+       '(dos-font-lock-keywords nil t)) ; case-insensitive keywords
+  (set (make-local-variable 'imenu-generic-expression) '((nil "^:[^:].*" 0)))
+  (set (make-local-variable 'outline-regexp) ":[^:]")
+  (set-syntax-table dos-mode-syntax-table))
+
+(provide 'dos)
+
+;;; dos.el ends here
diff --git a/lisp/subr.el b/lisp/subr.el
index bdeee677471..43a9fc015b1 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2755,7 +2755,7 @@ Otherwise, return nil."
   (let ((def (indirect-function object t)))
     (when (consp def)
       (or (eq 'macro (car def))
-          (and (eq 'autoload (car def)) (memq (nth 4 def) '(macro t)))))))
+          (and (autoloadp def) (memq (nth 4 def) '(macro t)))))))
 
 (defun field-at-pos (pos)
   "Return the field at position POS, taking stickiness etc into account."