;;; ess-bugs-d.el --- ESS[BUGS] dialect

;; Copyright (C) 2008-2011 Rodney Sparapani

;; Author: Rodney Sparapani
;; Created: 13 March 2008
;; Maintainer: ESS-help <ess-help@r-project.org>

;; This file is part of ESS

;; This file 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 2, or (at your option)
;; any later version.
;;
;; This file 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.
;;
;; A copy of the GNU General Public License is available at
;; https://www.r-project.org/Licenses/

;;; Code:

(require 'ess-bugs-l)
(require 'ess-utils)
(require 'ess-inf)
(require 'ess-custom)
(require 'ess-mode)

(setq auto-mode-alist
      (append '(("\\.[bB][uU][gG]\\'" . ess-bugs-mode)) auto-mode-alist))

(defvar ess-bugs-command "OpenBUGS" "Default BUGS program in PATH.")
(make-local-variable 'ess-bugs-command)

(defvar ess-bugs-monitor '("") "Default list of variables to monitor.")
(make-local-variable 'ess-bugs-monitor)

(defvar ess-bugs-thin 1 "Default thinning parameter.")
(make-local-variable 'ess-bugs-thin)

(defvar ess-bugs-chains 1 "Default number of chains.")
(make-local-variable 'ess-bugs-chains)

(defvar ess-bugs-burnin 10000 "Default burn-in.")
(make-local-variable 'ess-bugs-burnin)

(defvar ess-bugs-update 10000 "Default number of updates after burnin.")
(make-local-variable 'ess-bugs-update)

(defvar ess-bugs-system nil "Default whether BUGS recognizes the system command.")

(defvar ess-bugs-font-lock-keywords
  (list
   ;; .bug files
   (cons "#.*\n"                        font-lock-comment-face)

   (cons "^[ \t]*\\(model\\|var\\)\\>"
         font-lock-keyword-face)

   (cons (concat "\\<d\\(bern\\|beta\\|bin\\|cat\\|chisq\\|"
                 "dexp\\|dirch\\|exp\\|\\(gen[.]\\)?gamma\\|hyper\\|"
                 "interval\\|lnorm\\|logis\\|mnorm\\|mt\\|multi\\|"
                 "negbin\\|norm\\(mix\\)?\\|par\\|pois\\|sum\\|t\\|"
                 "unif\\|weib\\|wish\\)[ \t\n]*(")
         font-lock-constant-face)

   (cons (concat "\\<\\(abs\\|cos\\|C\\|dim\\|\\(i\\)?cloglog\\|equals\\|"
                 "exp\\|for\\|inprod\\|interp[.]line\\|inverse\\|length\\|"
                 "\\(i\\)?logit\\|logdet\\|logfact\\|loggam\\|max\\|mean\\|"
                 "mexp\\|min\\|phi\\|pow\\|probit\\|prod\\|rank\\|round\\|"
                 "sd\\|sin\\|sort\\|sqrt\\|step\\|sum\\|t\\|trunc\\|T\\)[ \t\n]*(")
         font-lock-function-name-face)

   ;; .bmd files
   (cons (concat (regexp-opt '(
                               "dicClear" "dicSet" "dicStats"
                               "infoMemory" "infoModules" "infoNodeMethods"
                               "infoNodeTypes" "infoNodeValues"
                               "infoUpdatersbyDepth" "infoUpdatersbyName"
                               "modelCheck" "modelCompile" "modelData"
                               "modelDisable" "modelEnable" "modelGenInits"
                               "modelInits" "modelPrecision" "modelQuit"
                               "modelSaveState" "modelSetAP" "modelSetIts"
                               "modelSetOR" "modelSetRN" "modelUpdate"
                               "ranksClear" "ranksSet" "ranksStats"
                               "samplesAutoC" "samplesBgr" "samplesCoda"
                               "samplesDensity" "samplesHistory" "samplesSet"
                               "sampleStats" "samplesThin"
                               "summaryClear" "summarySet" "summaryStats"
                               ) 'words) "(")
         font-lock-function-name-face)

   (cons (concat (regexp-opt '("Local Variables" "End") 'words) ":")
         font-lock-keyword-face)
   )
  "ESS[BUGS]: Font lock keywords."
  )

(defun ess-bugs-switch-to-suffix (suffix &optional bugs-chains bugs-monitor bugs-thin
                                         bugs-burnin bugs-update)
  "ESS[BUGS]: Switch to file with suffix."
  (find-file (concat ess-bugs-file-dir ess-bugs-file-root suffix))

  (if (equal 0 (buffer-size)) (progn
                                (if (equal ".bug" suffix) (progn
                                        ;(insert "var ;\n")
                                                            (insert "model {\n")
                                                            (insert "    for (i in 1:N) {\n    \n")
                                                            (insert "    }\n")
                                                            (insert "}\n")
                                                            (insert "#Local Variables" ":\n")
                                        ;           (insert "#enable-local-variables: :all\n")
                                                            (insert "#ess-bugs-chains:1\n")
                                                            (insert "#ess-bugs-monitor:(\"\")\n")
                                                            (insert "#ess-bugs-thin:1\n")
                                                            (insert "#ess-bugs-burnin:10000\n")
                                                            (insert "#ess-bugs-update:10000\n")
                                                            (insert "#End:\n")
                                                            ))

                                (if (equal ".bmd" suffix) (let
                                                              ((ess-bugs-temp-chains "") (ess-bugs-temp-monitor "") (ess-bugs-temp-chain ""))

                                                            (if bugs-chains (setq ess-bugs-chains bugs-chains))
                                                            (if bugs-monitor (setq ess-bugs-monitor bugs-monitor))
                                                            (if bugs-thin (setq ess-bugs-thin bugs-thin))

                                                            (setq ess-bugs-temp-chains
                                                                  (concat "modelCompile(" (format "%d" ess-bugs-chains) ")\n"))

                                                            (setq bugs-chains ess-bugs-chains)

                                                            (while (< 0 bugs-chains)
                                                              (setq ess-bugs-temp-chains
                                                                    (concat ess-bugs-temp-chains
                                                                            "modelInits('" ess-bugs-file-root
                                                                            ".##" (format "%d" bugs-chains) "', "
                                                                            (format "%d" bugs-chains) ")\n"))
                                                              (setq bugs-chains (- bugs-chains 1)))

                                                            (setq ess-bugs-temp-monitor "")

                                                            (while (and (listp ess-bugs-monitor) (consp ess-bugs-monitor))
                                                              (if (not (string-equal "" (car ess-bugs-monitor)))
                                                                  (setq ess-bugs-temp-monitor
                                                                        (concat ess-bugs-temp-monitor "samplesSet('"
                                                                                (car ess-bugs-monitor)
                                        ;", thin(" (format "%d" ess-bugs-thin)
                                                                                "')\n")))
                                                              (setq ess-bugs-monitor (cdr ess-bugs-monitor)))

                                                            (insert "modelCheck('" ess-bugs-file-root ".bug')\n")
                                                            (insert "modelData('" ess-bugs-file-root ".bdt')\n")
                                                            (insert (ess-replace-in-string ess-bugs-temp-chains "##" "in"))
                                                            (insert "modelGenInits()\n")
                                                            (insert "modelUpdate(" (format "%d" bugs-burnin) ")\n")
                                        ;(insert "modelUpdate(" (format "%d" (* bugs-thin bugs-burnin)) ")\n")
                                                            (insert ess-bugs-temp-monitor)
                                                            (insert "modelUpdate(" (format "%d" (* bugs-thin bugs-update)) ")\n")
                                        ;           (insert (ess-replace-in-string
                                        ;               (ess-replace-in-string ess-bugs-temp-chains
                                        ;                   "modelCompile([0-9]+)" "#") "##" "to"))

                                                            (if (< 1 bugs-thin) (insert "samplesThin(" (format "%d" bugs-thin) ")\n"))

                                                            (insert "samplesCoda('*', '" ess-bugs-file-root "')\n")

                                        ;           (if ess-bugs-system (progn
                                        ;               (insert "system rm -f " ess-bugs-file-root ".ind\n")
                                        ;               (insert "system ln -s " ess-bugs-file-root "index.txt " ess-bugs-file-root ".ind\n")

                                        ;               (setq bugs-chains ess-bugs-chains)

                                        ;               (while (< 0 bugs-chains)
                                        ;                   (setq ess-bugs-temp-chain (format "%d" bugs-chains))

                                        ;                   ;.txt not recognized by BOA and impractical to over-ride
                                        ;                   (insert "system rm -f " ess-bugs-file-root ess-bugs-temp-chain ".out\n")
                                        ;                   (insert "system ln -s " ess-bugs-file-root "chain" ess-bugs-temp-chain ".txt "
                                        ;                       ess-bugs-file-root ess-bugs-temp-chain ".out\n")
                                        ;                   (setq bugs-chains (- bugs-chains 1)))))

                                                            (insert "modelQuit()\n")
                                                            (insert "Local Variables" ":\n")
                                        ;           (insert "enable-local-variables: :all\n")
                                                            (insert "ess-bugs-chains:" (format "%d" ess-bugs-chains) "\n")
                                                            (insert "ess-bugs-command:\"" ess-bugs-command "\"\n")
                                                            (insert "End:\n")
                                                            ))
                                ))
  )

(defun ess-bugs-na-bmd (bugs-command bugs-chains)
  "ESS[BUGS]: Perform the Next-Action for .bmd."
                                        ;(ess-save-and-set-local-variables)
  (if (equal 0 (buffer-size)) (ess-bugs-switch-to-suffix ".bmd")
                                        ;else
    (shell)
    (ess-sleep)

    (when (and (when (fboundp 'w32-shell-dos-semantics)
                 (w32-shell-dos-semantics))
               (string-equal ":" (substring ess-bugs-file 1 2)))
      (insert (substring ess-bugs-file 0 2)))

    (comint-send-input)
    (insert "cd \"" ess-bugs-file-dir "\"")
    (comint-send-input)

                                        ;    (let ((ess-bugs-temp-chains ""))
                                        ;
                                        ;       (while (< 0 bugs-chains)
                                        ;           (setq ess-bugs-temp-chains
                                        ;               (concat (format "%d " bugs-chains) ess-bugs-temp-chains))
                                        ;           (setq bugs-chains (- bugs-chains 1)))

    ;; (insert "echo '"
    ;;       ess-bugs-batch-pre-command " " bugs-command " < "
    ;;       ess-bugs-file-root ".bmd > " ess-bugs-file-root ".bog 2>&1 "
    ;;       ess-bugs-batch-post-command "' > " ess-bugs-file-root ".bsh")
    ;; (comint-send-input)

    ;; (insert "at -f " ess-bugs-file-root ".bsh now")

    ;; (comint-send-input)

    (insert "echo '"
            ess-bugs-batch-pre-command " " bugs-command " < "
            ess-bugs-file-root ".bmd > " ess-bugs-file-root ".bog 2>&1 "
            ess-bugs-batch-post-command "' | at now")

    (comint-send-input)
    ))

(defun ess-bugs-na-bug ()
  "ESS[BUGS]: Perform Next-Action for .bug"

  (if (equal 0 (buffer-size)) (ess-bugs-switch-to-suffix ".bug")
                                        ;else
    (ess-save-and-set-local-variables)
    (ess-bugs-switch-to-suffix ".bmd"
                               ess-bugs-chains ess-bugs-monitor ess-bugs-thin ess-bugs-burnin ess-bugs-update))
  )

;;;###autoload
(defun ess-bugs-mode ()
  "ESS[BUGS]: Major mode for BUGS."
  (interactive)
  (kill-all-local-variables)
  (ess-setq-vars-local '((comment-start . "#")))
  (setq major-mode 'ess-bugs-mode)
  (setq mode-name "ESS[BUGS]")
  (use-local-map ess-bugs-mode-map)
  (make-local-variable 'font-lock-defaults)
  (setq font-lock-defaults '(ess-bugs-font-lock-keywords nil t))
  (setq ess-language "S") ; mimic S for ess-smart-underscore
  (run-mode-hooks 'ess-bugs-mode-hook)

  (unless (when (fboundp 'w32-shell-dos-semantics)
            (w32-shell-dos-semantics))
    (add-hook 'comint-output-filter-functions 'ess-bugs-exit-notify-sh))
  )

;;;###autoload
(add-to-list 'auto-mode-alist '("\\.[Bb][Uu][Gg]\\'" . ess-bugs-mode))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.[Bb][Oo][Gg]\\'" . ess-bugs-mode))
;;;###autoload
(add-to-list 'auto-mode-alist '("\\.[Bb][Mm][Dd]\\'" . ess-bugs-mode))

(defun ess-sci-to-dec ()
  "For BUGS/S family: Express +/-0.000E+/-0 or +/-0.0e+/-00 as a decimal."
  (interactive)
  (setq buffer-read-only nil)
  (save-excursion (goto-char 0)
                  (save-match-data (let ((ess-temp-replacement-string nil)
                                         (ess-temp-replacement-9 0)
                                         (ess-temp-replacement-diff 0))
                                     (while (search-forward-regexp "-?[0-9][.][0-9][0-9]?[0-9]?[Ee][+-][0-9][0-9]?" nil t)
                                       (setq ess-temp-replacement-string
                                             (int-to-string (string-to-number (match-string 0))))
                                       (setq ess-temp-replacement-diff (- (match-end 0) (match-beginning 0)))
                                       (save-match-data
                                         (setq ess-temp-replacement-9
                                               (string-match "99999999999$" ess-temp-replacement-string))

                                         (if (not ess-temp-replacement-9)
                                             (setq ess-temp-replacement-9
                                                   (string-match "000000000001$" ess-temp-replacement-string))))

                                       (if ess-temp-replacement-9
                                           (setq ess-temp-replacement-string
                                                 (substring ess-temp-replacement-string 0 ess-temp-replacement-9)))

                                       (setq ess-temp-replacement-diff
                                             (- ess-temp-replacement-diff (string-width ess-temp-replacement-string)))

                                       (while (> ess-temp-replacement-diff 0)
                                         (setq ess-temp-replacement-string (concat ess-temp-replacement-string " "))
                                         (setq ess-temp-replacement-diff (- ess-temp-replacement-diff 1)))

                                       (replace-match ess-temp-replacement-string))))))

(setq features (delete 'ess-bugs-d features))
(provide 'ess-bugs-d)

;;; ess-bugs-d.el ends here