lisp/essd-jags.el

   1 ;;; essd-jags.el -- ESS[JAGS] dialect
   2
   3 ;; Copyright (C) 2006 Rodney Sparapani
   4
   5 ;; Original Author: Rodney Sparapani <rsparapa@mcw.edu>
   6 ;; Created: 16 August 2006
   7 ;; Maintainers: ESS-help <ess-help@stat.math.ethz.ch>
   8
   9 ;; This file is part of ESS
  10
  11 ;; This file is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This file is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24 ;;
  25 ;; In short: you may use this code any way you like, as long as you
  26 ;; don't charge money for it, remove this notice, or hold anyone liable
  27 ;; for its results.
  28
  29 ;; Code:
  30
  31 (require 'essl-bugs)
  32
  33 (setq auto-mode-alist
  34     (delete '("\\.[bB][uU][gG]\\'" . ess-bugs-mode) auto-mode-alist))
  35
  36 (setq auto-mode-alist
  37     (append '(("\\.[bB][uU][gG]\\'" . ess-jags-mode)) auto-mode-alist))
  38
  39 (setq ess-bugs-batch-command "jags")
  40
  41 (defvar ess-bugs-font-lock-keywords
  42     (list
  43         ;; .bug files
  44         (cons "#.*\n"                   font-lock-comment-face)
  45
  46         (cons "^[ \t]*\\(model\\|var\\)\\>"
  47                                         font-lock-keyword-face)
  48
  49         ;(cons "\\<in[ \t]+[1-9]\\>"    font-lock-keyword-face)
  50
  51         (cons (concat "\\<d\\(bern\\|beta\\|bin\\|cat\\|chisqr\\|"
  52                 "dexp\\|dirch\\|exp\\|gamma\\|interval\\|lnorm\\|logis\\|"
  53                 "mnorm\\|multi\\|negbin\\|norm\\|par\\|pois\\|"
  54                 "sum\\|t\\|unif\\|weib\\|wish\\)[ \t\n]*(")
  55                                         font-lock-reference-face)
  56
  57         (cons (concat "\\<\\(for\\|cloglog\\|equals\\|exp\\|inprod\\|"
  58                 "inverse\\|log\\(det\\|fact\\|gam\\|it\\)?\\|max\\|"
  59                 "mean\\|min\\|phi\\|pow\\|probit\\|sd\\|sort\\|sqrt\\|"
  60                 "step\\|sum\\|T\\)[ \t\n]*(")
  61                                         font-lock-function-name-face)
  62
  63         ;; .jmd files
  64         (cons (concat "\\<\\(clear\\|coda\\|compile\\|data\\|"
  65                 "exit\\|in\\|initialize\\|monitor\\|parameters\\|"
  66                 "seed\\|set\\|to\\|update\\)\\>")
  67                                         font-lock-keyword-face)
  68
  69         (cons (concat "\\<\\(by\\|chain\\|nchains\\|stem\\|thin\\)[ \t\n]*(")
  70                                         font-lock-function-name-face)
  71     )
  72     "ESS[JAGS]: Font lock keywords."
  73 )
  74
  75 (defun ess-bugs-switch-to-suffix (suffix)
  76    "ESS[JAGS]: Switch to file with suffix."
  77    (find-file (concat ess-bugs-file-dir ess-bugs-file-root suffix))
  78
  79    (if (equal 0 (buffer-size)) (progn
  80         (if (equal ".bug" suffix) (progn
  81             (insert "var ;\n")
  82             (insert "#%MONITOR;\n")
  83             (insert "model {\n")
  84             (insert "    for (i in 1:N) {\n    \n")
  85             (insert "    }\n")
  86             (insert "}\n")
  87         ))
  88
  89         (if (equal ".jmd" suffix) (progn
  90             (insert (concat "model in \"" ess-bugs-file-dir ess-bugs-file-root ".bug\"\n"))
  91             (insert (concat "data in \"" ess-bugs-file-dir ess-bugs-file-root ".bug\"\n"))
  92             (insert "compile\n")
  93             (insert (concat "parameters in \"" ess-bugs-file-dir ess-bugs-file-root ".in\"\n"))
  94             (insert "initialize\n")
  95             (insert (concat "parameters to \"" ess-bugs-file-dir ess-bugs-file-root ".in0\"\n"))
  96             (insert (concat "update " ess-bugs-default-burn-in "\n"))
  97             (insert (concat "parameters to \"" ess-bugs-file-dir ess-bugs-file-root ".in1\"\n"))
  98             (insert "#%MONITOR\n\n#%MONITOR\n")
  99             (insert (concat "update " ess-bugs-default-update "\n"))
 100             (insert (concat "parameters to \"" ess-bugs-file-dir ess-bugs-file-root ".in2\"\n"))
 101             (insert "exit\n")
 102         ))
 103     ))
 104 )
 105
 106 (defun ess-bugs-next-action ()
 107    "ESS[JAGS]: Perform the appropriate next action."
 108    (interactive)
 109    (ess-bugs-file)
 110
 111    (if (equal ".bug" ess-bugs-file-suffix) (ess-bugs-na-bug))
 112    ;;else
 113    (if (equal ".jmd" ess-bugs-file-suffix) (ess-bugs-na-jmd))
 114 )
 115
 116 (defun ess-bugs-na-jmd ()
 117     "ESS[JAGS]: Perform the Next-Action for .jmd."
 118
 119     (save-buffer)
 120     (shell)
 121
 122     (if (w32-shell-dos-semantics)
 123         (if (string-equal ":" (substring ess-bugs-file 1 2))
 124             (progn
 125                 (insert (substring ess-bugs-file 0 2))
 126                 (comint-send-input)
 127             )
 128         )
 129     )
 130
 131         (insert (concat "cd \"" ess-bugs-file-dir "\""))
 132         (comint-send-input)
 133
 134         (insert (concat ess-bugs-batch-pre-command " " ess-bugs-batch-command " "
 135              (concat ess-bugs-file-root ".jmd") " " ess-bugs-batch-post-command))
 136
 137         (comint-send-input)
 138 )
 139
 140 (defun ess-bugs-na-bug ()
 141     "ESS[JAGS]: Perform Next-Action for .bug"
 142
 143         (if (equal 0 (buffer-size)) (ess-bugs-switch-to-suffix ".bug")
 144             (save-excursion
 145                 (goto-char (point-min))
 146
 147                 (let (
 148                     (ess-bugs-search-min nil)
 149                     (ess-bugs-search-max nil)
 150                     (ess-bugs-search-vars
 151 "\\([a-zA-Z0-9.]+\\)\\(\\(\\[\\)[a-zA-Z0-9]*\\(,\\)?[a-zA-Z0-9]*\\(\\]\\)\\)?[ \t]*[,]?[ \t]*\\(#.*\\)?[\n]?"
 152                     ))
 153
 154                     (goto-char (point-min))
 155
 156                     (if (search-forward-regexp "%MONITOR[ \t]+" nil t)
 157                         (setq ess-bugs-search-min (point))
 158                     ;;else
 159                         (setq ess-bugs-search-min (search-forward "var"))
 160                     )
 161
 162                     (setq ess-bugs-search-max (search-forward-regexp ";"))
 163
 164                     (goto-char ess-bugs-search-min)
 165                     (setq ess-bugs-monitor-vars "")
 166
 167                     (while (search-forward-regexp ess-bugs-search-vars ess-bugs-search-max t)
 168
 169                         (setq ess-bugs-monitor-vars
 170                             (concat ess-bugs-monitor-vars "monitor set "
 171                                 (match-string 1) (match-string 3) (match-string 4) (match-string 5) "\n"))
 172                     )
 173
 174                     (setq ess-bugs-monitor-vars
 175                         (concat "#%MONITOR\n" ess-bugs-monitor-vars "#%MONITOR\n"))
 176             ))
 177
 178             (save-buffer)
 179             (ess-bugs-switch-to-suffix ".jmd"))
 180
 181     (save-excursion
 182         (goto-char (point-min))
 183
 184         (if (search-forward-regexp "#%MONITOR\\(.\\|\n\\)*#%MONITOR\n" nil t)
 185             (replace-match ess-bugs-monitor-vars t))
 186         )
 187 )
 188
 189 (defun ess-jags-mode ()
 190    "ESS[JAGS]: Major mode for JAGS."
 191    (interactive)
 192    (kill-all-local-variables)
 193    (setq major-mode 'ess-jags-mode)
 194    (setq mode-name "ESS[JAGS]")
 195    (use-local-map ess-bugs-mode-map)
 196    (setq font-lock-auto-fontify t)
 197    (make-local-variable 'font-lock-defaults)
 198    (setq font-lock-defaults '(ess-bugs-font-lock-keywords nil t))
 199    (run-hooks 'ess-bugs-mode-hook)
 200
 201    (if (not (w32-shell-dos-semantics))
 202         (add-hook 'comint-output-filter-functions 'ess-bugs-exit-notify-sh))
 203 )
 204
 205 (setq features (delete 'essd-bugs features))
 206 (provide 'essd-jags)