lisp/essl-bugs.el

   1 ;;; essl-bugs.el -- ESS[BUGS] languages
   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 'font-lock)
  32 (require 'comint)
  33 (require 'ess-emcs)
  34
  35 (defgroup ess-bugs nil
  36   "ESS: BUGS."
  37   :group 'ess
  38   :prefix "ess-")
  39
  40 (defcustom ess-bugs-batch-method
  41   (if ess-microsoft-p (if (w32-shell-dos-semantics) 'dos 'sh) 'sh)
  42   "Method used by `ess-bugs-batch'.
  43 The default is based on the value of the emacs variable `system-type'
  44 and, on Windows machines, the function `w32-shell-dos-semantics'.
  45 'sh           if *shell* runs a Bourne-like or a C-like Unix shell
  46 'dos          if *shell* runs a DOS-like Windows shell
  47
  48 Unix users will get 'sh by default.
  49
  50 Windows users running a DOS-like *shell* will get 'dos by default,
  51 while those running a Unix-like *shell* will get 'sh by default.
  52
  53 Users whose default is not 'sh, but are accessing a remote machine with
  54 `telnet' or `ssh', should have the following in their init file:
  55    (setq-default ess-bugs-batch-method 'sh)"
  56     :group 'ess-bugs
  57 )
  58
  59 (defcustom ess-bugs-batch-post-command
  60     (if (equal ess-bugs-batch-method 'sh) "&" " ")
  61     "*ESS[BUGS]: Modifiers at the end of the batch BUGS command line."
  62     :group 'ess-bugs
  63     :type  'string
  64 )
  65
  66 (defcustom ess-bugs-batch-pre-command
  67     (if (equal ess-bugs-batch-method 'sh) "rm -f nohup.out; nohup"
  68         (if ess-microsoft-p "start"))
  69     "*ESS[BUGS]: Modifiers at the beginning of the batch BUGS command line."
  70     :group 'ess-bugs
  71     :type  'string
  72 )
  73
  74
  75 (defcustom ess-bugs-default-burn-in "500"
  76     "ESS[BUGS]: Burn-in iterations to discard."
  77     :group 'ess-bugs
  78     :type  'string
  79 )
  80
  81 (defcustom ess-bugs-default-update "1000"
  82     "ESS[BUGS]: Iterations to store."
  83     :group 'ess-bugs
  84     :type  'string
  85 )
  86
  87 (defvar ess-bugs-batch-command ";"
  88   "*ESS[BUGS]: The name of the command to run BUGS in batch mode."
  89 )
  90
  91 (defvar ess-bugs-file "."
  92    "ESS[BUGS]: BUGS file with PATH.")
  93
  94 (defvar ess-bugs-file-root "."
  95    "ESS[BUGS]: Root of BUGS file.")
  96
  97 (defvar ess-bugs-file-suffix "."
  98    "ESS[BUGS]: Suffix of BUGS file.")
  99
 100 (defvar ess-bugs-file-dir "."
 101    "ESS[BUGS]: Directory of BUGS file.")
 102
 103 (defvar ess-bugs-file-data "..."
 104    "ESS[BUGS]: BUGS data file.")
 105
 106 (defcustom ess-bugs-inits-suffix ".in"
 107    "ESS[BUGS]: BUGS init file suffix."
 108     :group 'ess-bugs
 109     :type  'string
 110 )
 111
 112 (defcustom ess-bugs-data-suffix ".dat"
 113    "ESS[BUGS]: BUGS data file suffix."
 114     :group 'ess-bugs
 115     :type  'string
 116 )
 117
 118 (defcustom ess-bugs-mode-hook nil
 119     "*ESS[BUGS]: List of functions to call upon entering mode."
 120     :group 'ess-bugs
 121     :type 'hook)
 122
 123 (defvar ess-bugs-monitor-vars " "
 124     "ESS[BUGS]: List of BUGS variables to be written out to a file.")
 125
 126 (defvar ess-bugs-stats-vars " "
 127     "ESS[BUGS]: List of BUGS variables to be summarized with statistics.")
 128
 129 (defvar ess-bugs-mode-map nil
 130    "ESS[BUGS]: Keymap for mode.")
 131
 132 (if ess-bugs-mode-map nil (setq ess-bugs-mode-map (make-keymap)))
 133 (define-key ess-bugs-mode-map (quote [f2])  'ess-revert-wisely)
 134 ;(define-key ess-bugs-mode-map (quote [f12]) 'ess-bugs-next-action)
 135 (define-key ess-bugs-mode-map "\C-c\C-c" 'ess-bugs-next-action)
 136
 137 (defvar ess-bugs-syntax-table nil
 138    "ESS[BUGS]: Syntax table for mode.")
 139
 140 (if ess-bugs-syntax-table nil (setq ess-bugs-syntax-table (make-syntax-table)))
 141 (modify-syntax-entry ?\\ "."  ess-bugs-syntax-table)
 142 (modify-syntax-entry ?#  "<"  ess-bugs-syntax-table)
 143 (modify-syntax-entry ?\n ">"  ess-bugs-syntax-table)
 144 (modify-syntax-entry ?(  "()" ess-bugs-syntax-table)
 145 (modify-syntax-entry ?)  ")(" ess-bugs-syntax-table)
 146 (modify-syntax-entry ?.  "w"  ess-bugs-syntax-table)
 147
 148 (defun ess-bugs-file ()
 149 "ESS[BUGS]: Set internal variables dealing with BUGS files.
 150 Set `ess-bugs-file', `ess-bugs-file-root', `ess-bugs-file-suffix'
 151 and `ess-bugs-file-dir'."
 152    (let ((ess-bugs-temp-string (buffer-name)))
 153         (setq ess-bugs-file (expand-file-name ess-bugs-temp-string))
 154         (setq ess-bugs-file-dir
 155             (convert-standard-filename (file-name-directory ess-bugs-file)))
 156         (setq ess-bugs-file-root
 157             (file-name-nondirectory (file-name-sans-extension ess-bugs-file)))
 158
 159         (if (fboundp 'file-name-extension)
 160             (setq ess-bugs-file-suffix (file-name-extension ess-bugs-temp-string))
 161             ;;else
 162             (setq ess-bugs-file-suffix (car (last (split-string ess-bugs-temp-string "[.]")))))
 163
 164         (setq ess-bugs-file-suffix
 165             (downcase (car (split-string (concat "." ess-bugs-file-suffix) "[<]"))))
 166
 167         (setq ess-bugs-file (concat ess-bugs-file-dir ess-bugs-file-root ess-bugs-file-suffix))
 168    )
 169 )
 170
 171 (defun ess-bugs-exit-notify-sh (string)
 172   "ESS[BUGS]: Detect completion or failure of submitted job and notify the user."
 173   (let* ((exit-done "\\[[0-9]+\\]\\ *\\+*\\ *\\(Exit\\|Done\\).*$")
 174          (beg (string-match exit-done string)))
 175     (if beg (message (substring string beg (match-end 0))))))
 176
 177 (defun ess-bugs-sci-to-round-4-dp ()
 178     "ESS[BUGS]: round output from +/-0.000E+/-0 to 4 decimal places."
 179     (interactive)
 180     (setq buffer-read-only nil)
 181     (save-excursion (goto-char 0)
 182     (save-match-data (let ((ess-bugs-replacement-string nil)
 183                             (ess-bugs-replacement-9 0)
 184                             (ess-bugs-replacement-diff 0))
 185      (while (search-forward-regexp "-?[0-9][.][0-9][0-9][0-9]E[+-][0-9]" nil t)
 186             (setq ess-bugs-replacement-string
 187                   (int-to-string (string-to-number (match-string 0))))
 188             (setq ess-bugs-replacement-diff (- (match-end 0) (match-beginning 0)))
 189             (save-match-data
 190                 (setq ess-bugs-replacement-9
 191                     (string-match "99999999999$" ess-bugs-replacement-string))
 192
 193                 (if (not ess-bugs-replacement-9)
 194                     (setq ess-bugs-replacement-9
 195                         (string-match "000000000001$" ess-bugs-replacement-string))))
 196
 197             (if ess-bugs-replacement-9
 198                 (setq ess-bugs-replacement-string
 199                     (substring ess-bugs-replacement-string 0 ess-bugs-replacement-9)))
 200
 201             (setq ess-bugs-replacement-diff
 202                 (- ess-bugs-replacement-diff (string-width ess-bugs-replacement-string)))
 203
 204            (while (> ess-bugs-replacement-diff 0)
 205                 (setq ess-bugs-replacement-string (concat ess-bugs-replacement-string " "))
 206                 (setq ess-bugs-replacement-diff (- ess-bugs-replacement-diff 1)))
 207
 208            (replace-match ess-bugs-replacement-string))))))
 209
 210 ;;; ESS[BUGS-Shell] for running BUGS interactively
 211 (defgroup ess-bugs-shell nil
 212   "ESS: BUGS-Shell."
 213   :group 'ess-bugs
 214   :prefix "ess-")
 215
 216 (defcustom ess-bugs-shell-buffer-name "BUGS"
 217   "*ESS[BUGS-Shell]: The name of the BUGS-Shell buffer."
 218   :group 'ess-bugs-shell
 219   :type  'string)
 220
 221 (defcustom ess-bugs-shell-command "bugs"
 222   "*ESS[BUGS-Shell]: The name of the command to run BUGS interactively.
 223
 224 Set to the name of the batch BUGS script that comes with ESS or
 225 to the name of BUGS command. Make sure it is in your PATH or
 226 add path to the command name."
 227   :group 'ess-bugs-shell
 228   :type  'string)
 229
 230 (defcustom ess-bugs-shell-default-output-file-root "bugs"
 231   "*ESS[BUGS-Shell]: Default value for the root of output files."
 232   :group 'ess-bugs-shell
 233   :type  'string)
 234
 235 (defcustom ess-bugs-shell-mode-hook nil
 236   "*ESS[BUGS-Shell]: List of functions to call upon entering mode."
 237   :group 'ess-bugs-shell
 238   :type 'hook)
 239
 240 (defun ess-bugs-shell ()
 241   "Create a buffer with BUGS running as a subprocess."
 242   (interactive)
 243   (require 'shell)
 244   (switch-to-buffer (concat "*" ess-bugs-shell-buffer-name "*"))
 245   (make-comint ess-bugs-shell-buffer-name ess-bugs-shell-command nil
 246                ess-bugs-default-bins ess-bugs-shell-default-output-file-root)
 247   (comint-mode)
 248   (setq shell-dirtrackp t
 249         major-mode 'bugs-shell-mode
 250         mode-name "ESS[BUGS-Shell]"
 251         comint-prompt-regexp "^Bugs> *")
 252    (make-local-variable 'font-lock-defaults)
 253    (setq font-lock-defaults '(ess-bugs-font-lock-keywords nil t))
 254    (run-hooks 'ess-bugs-shell-mode-hook)
 255   )
 256
 257 (provide 'essl-bugs)