lisp/essl-sta.el

   1 ;;; essl-sta.el --- Stata customization
   2
   3 ;; Copyright (C) 1999--2000, Thomas Lumley, A. J. Rossini, Brendan Halpin.
   4 ;; Copyright (C) 1997--2004 A.J. Rossini, Rich M. Heiberger, Martin
   5 ;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
   6
   7 ;; Original Authors: Thomas Lumley <thomas@biostat.washington.edu>,
   8 ;;                   Brendan Halpin <brendan@essex.ac.uk>
   9 ;; Created: 2 Nov 1997
  10 ;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>
  11
  12 ;; Keywords: start up, configuration.
  13
  14 ;; This file is part of ESS (Emacs Speaks Statistics).
  15
  16 ;; This file is free software; you can redistribute it and/or modify
  17 ;; it under the terms of the GNU General Public License as published by
  18 ;; the Free Software Foundation; either version 2, or (at your option)
  19 ;; any later version.
  20
  21 ;; This file is distributed in the hope that it will be useful,
  22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 ;; GNU General Public License for more details.
  25
  26 ;; You should have received a copy of the GNU General Public License
  27 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  28 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  29
  30 ;;; Commentary:
  31 ;;; This is based upon Version 0.4 of Stata mode.
  32
  33
  34
  35
  36 ;;
  37 ;; Stata modes.  Emacs modes for using the Stata statistical package
  38 ;; Modified from S-mode, comint-mode
  39 ;;
  40 ;; (c) thomas lumley 1997
  41 ;;
  42 ;;  version 0.4  20/7/97
  43 ;;
  44 ;; This file is free software; you can redistribute it and/or modify
  45 ;; it under the terms of the GNU General Public License as published by
  46 ;; the Free Software Foundation; either version 2, or (at your option)
  47 ;; any later version.
  48 ;;
  49 ;; This file is distributed in the hope that it will be useful,
  50 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  51 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  52 ;; GNU General Public License for more details.
  53 ;;
  54 ;; You should have received a copy of the GNU General Public License
  55 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  56 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  57 ;;
  58
  59
  60 (require 'make-regexp)  ; it's now local to the directory.
  61 ;;(load-library "make-regexp") ;; this is necessary for
  62                              ;; ado-set-font-lock-keywords
  63 ;; only needed in Emacs >= 22.x and newish Xemacsen:
  64 (unless (boundp 'c-emacs-features)
  65   (require 'cc-vars));; for syntax-table
  66
  67 ;(setq max-lisp-eval-depth 500)
  68 (eval-when-compile
  69   (setq max-lisp-eval-depth (max 600 max-lisp-eval-depth)))
  70
  71 (defconst ess-help-STA-sec-keys-alist
  72   '((?d . "Description")
  73     (?e . "Examples")
  74     (?o . "Options")
  75     (?s . "Also see"))
  76   "Help section keys for S4.
  77 `key' indicates the keystroke to use to search for the section heading
  78 `string' in an Stata help file. `string' is used as part of a
  79 regexp-search, and so specials should be quoted.
  80 ")
  81
  82 (defconst ess-help-STA-sec-regex "^[A-Z a-z]+:?\n^[-]+$"
  83   "Reg(ular) Ex(pression) of section headers in help file.")
  84
  85 (defvar STA-syntax-table nil "Syntax table for Stata code.")
  86 (if STA-syntax-table
  87     nil
  88   (setq STA-syntax-table (make-syntax-table))
  89   (modify-syntax-entry ?\\ "." STA-syntax-table) ;nullify escape meaning
  90   (modify-syntax-entry ?\$ "." STA-syntax-table)
  91   (modify-syntax-entry ?` "(\'" STA-syntax-table)
  92   (modify-syntax-entry ?\' ")`" STA-syntax-table)
  93   ;;--------- begin cut-and-paste from  lisp/progmodes/c-langs.el
  94   (cond
  95    ;; XEmacs 19, 20, 21
  96    ((memq '8-bit c-emacs-features)
  97     (modify-syntax-entry ?/  ". 1456" STA-syntax-table)
  98     (modify-syntax-entry ?*  ". 23"   STA-syntax-table))
  99    ;; Emacs 19, 20, 21
 100    ((memq '1-bit c-emacs-features)
 101     (modify-syntax-entry ?/  ". 124b" STA-syntax-table)
 102     (modify-syntax-entry ?*  ". 23"   STA-syntax-table))
 103    ;; incompatible
 104    (t (error "CC Mode is incompatible with this version of Emacs"))
 105    )
 106   (modify-syntax-entry ?\n "> b"  STA-syntax-table)
 107   ;; Give CR the same syntax as newline, for selective-display
 108   (modify-syntax-entry ?\^m "> b" STA-syntax-table)
 109   ;;--------- end cut-and-paste ------------------
 110   (modify-syntax-entry ?+ "." STA-syntax-table)
 111   (modify-syntax-entry ?- "." STA-syntax-table)
 112   (modify-syntax-entry ?= "." STA-syntax-table)
 113   (modify-syntax-entry ?% "." STA-syntax-table)
 114   (modify-syntax-entry ?< "." STA-syntax-table)
 115   (modify-syntax-entry ?> "." STA-syntax-table)
 116   (modify-syntax-entry ?& "." STA-syntax-table)
 117   (modify-syntax-entry ?| "." STA-syntax-table)
 118   (modify-syntax-entry ?~ "." STA-syntax-table))
 119
 120
 121 (defun ado-set-font-lock-keywords ()
 122   "Create font lock keywords for Stata syntax. This is from the
 123 ado-mode of Bill Rising <brising@jhsph.edu>, and uses make-regexp."
 124   ;; (make-local-variable 'ado-font-lock-keywords)
 125   (interactive)
 126   (list
 127    ;; special highlighting
 128    ;; program definitions
 129    (eval-when-compile
 130      (make-regexps
 131       '(("^\\*!.*") font-lock-keyword-face)
 132       ))
 133    (eval-when-compile
 134      (make-regexps
 135       "^"
 136       '((
 137          "pr" "pro" "prog" "progr" "progra" "program"
 138          ) font-lock-keyword-face)
 139       "[ \t]+"
 140       '((
 141          "de" "def" "defi" "defin" "define"
 142          "di" "dir"
 143          "drop"
 144          "l" "li" "lis" "list"
 145          ) font-lock-type-face nil)
 146       "[ \t]+"
 147       '(("[_a-z]+[_a-z0-9]*") font-lock-keyword-face nil)
 148       ))
 149    (eval-when-compile
 150      (make-regexps
 151       '(("^[ \t]*version") font-lock-reference-face)
 152       "[ \t]*"
 153       '(("1.0 2.0 2.1 3.0 3.1 4.0 5.0 6 6.0") font-lock-type-face)
 154       ))
 155    (eval-when-compile
 156      (make-regexps
 157       "^"
 158       '(("end" "pause"
 159          ) font-lock-keyword-face)
 160       "[ /t]*.*$"
 161       ))
 162    ;; delimit command
 163    (eval-when-compile
 164      (make-regexps
 165       '(("^[ \t]*#delimit") font-lock-reference-face)
 166       "\\s-*"
 167       '(("\\(cr\\|;\\)\\s-*$") font-lock-type-face nil)
 168       ))
 169    ;; set command (with endless options!)
 170    (eval-when-compile
 171      (make-regexps
 172       '(("^[ \t]*set") font-lock-reference-face)
 173       "[ \t]+"
 174       '(("adosize" "ANSI"
 175          "b" "be" "bee" "beep" "checksum" "contents"
 176          "d" "di" "dis" "disp" "displ" "displa" "display"
 177          "g" "gr" "gra" "grap" "graph" "graphi" "graphic" "graphics"
 178          "help"
 179          "IBM"
 180          "l" "le" "lev" "leve" "level"
 181          "linesize"
 182          "lo" "log"
 183          "mat" "mats" "matsi" "matsiz" "matsize"
 184          "maxobs" "maxvar"
 185          "mem" "memo" "memor" "memory"
 186          "mo" "mor" "more"
 187          "obs"
 188          "ou" "out" "outp" "outpu" "output"
 189          "pagesize"
 190          "r" "rm" "rms" "rmsg"
 191          "se" "see" "seed" "seed0" "shell"
 192          "te" "tex" "text" "texts" "textsi" "textsiz" "textsize"
 193          "tr" "tra" "trac" "trace"
 194          "t" "ty" "typ" "type" "video"
 195          "vir" "virt" "virtu" "virtua" "virtual"
 196          )
 197         font-lock-reference-face t)
 198       "[ \t]*"
 199       '(("[a-zA-Z0-9]*") font-lock-type-face)
 200       ))
 201    ;; the constraint commands
 202    (eval-when-compile
 203      (make-regexps
 204       "[ \t]+"
 205       '((
 206          "cons" "const" "constr" "constra" "constrai" "constrain" "constraint"
 207          ) font-lock-reference-face)
 208       "[ \t]+"
 209       '((
 210          "d"
 211          "de" "def" "defi" "defin" "define"
 212          "di" "dir"
 213          "drop"
 214          "l" "li" "lis" "list"
 215          )
 216         font-lock-type-face)
 217       "\\b"
 218       ))
 219    ;; the confirm commands - could be a mess!
 220    (eval-when-compile
 221      (make-regexps
 222       "[ \t]+"
 223       '((
 224          "conf" "confi" "confir" "confirm"
 225          ) font-lock-reference-face)
 226       "[ \t]+"
 227       '((
 228          "e" "ex" "exi" "exis" "exist" "existe" "existen" "existenc" "existence"
 229          "f" "fi" "fil" "file"
 230          "n" "nu" "num" "numb" "numbe" "number"
 231          "v" "va" "var" "vari" "varia" "variab" "variabl" "variable"
 232          ) font-lock-type-face)
 233       "\\b"
 234       ))
 235    (eval-when-compile
 236      (make-regexps
 237       "[ \t]+"
 238       '((
 239          "conf" "confi" "confir" "confirm"
 240          ) font-lock-reference-face)
 241       "[ \t]+"
 242       '((
 243          "integer"
 244          ) font-lock-type-face)
 245       "[ \t]+"
 246       '((
 247          "n" "nu" "num" "numb" "numbe" "number"
 248          ) font-lock-type-face)
 249       "\\b"
 250       ))
 251    (eval-when-compile
 252      (make-regexps
 253       "[ \t]+"
 254       '((
 255          "conf" "confi" "confir" "confirm"
 256          ) font-lock-reference-face)
 257       "[ \t]+"
 258       '((
 259          "n" "ne" "new"
 260          ) font-lock-type-face)
 261       "[ \t]+"
 262       '((
 263          "f" "fi" "fil" "file"
 264          "v" "va" "var" "vari" "varia" "variab" "variabl" "variable"
 265          ) font-lock-type-face)
 266       "\\b"
 267       ))
 268    (eval-when-compile
 269      (make-regexps
 270       "[ \t]+"
 271       '((
 272          "conf" "confi" "confir" "confirm"
 273          ) font-lock-reference-face)
 274       "[ \t]+"
 275       '((
 276          "byte" "double" "float" "int" "long"
 277          "numeric"
 278          "str" "stri" "strin" "string"
 279          ) font-lock-type-face)
 280       "[ \t]+"
 281       '((
 282          "v" "va" "var" "vari" "varia" "variab" "variabl" "variable"
 283          ) font-lock-type-face)
 284       "\\b"
 285       ))
 286     ;;; the str# won't quite look right, but that's the breaks for using
 287     ;;; a tool like this...
 288    (eval-when-compile
 289      (make-regexps
 290       "[ \t]+"
 291       '((
 292          "conf" "confi" "confir" "confirm"
 293          ) font-lock-reference-face)
 294       "[ \t]+"
 295       '((
 296          "str"
 297          ) font-lock-type-face)
 298       "[1-9]+[0-9]*[ \t]+"
 299       '((
 300          "v" "va" "var" "vari" "varia" "variab" "variabl" "variable"
 301          ) font-lock-type-face)
 302       "\\b"
 303       ))
 304    ;; the estimates commands
 305    (eval-when-compile
 306      (make-regexps
 307       "[ \t]+"
 308       '((
 309          "est" "esti" "estim" "estima" "estimat" "estimate" "estimates"
 310          ) font-lock-reference-face)
 311       "[ \t]+"
 312       '((
 313          "clear"
 314          "di" "dir" "dis" "disp" "displ" "displa" "display"
 315          "drop"
 316          "h" "ho" "hol" "hold"
 317          "li" "lis" "list"
 318          "loc" "loca" "local"
 319          "mat" "matr" "matri" "matrix"
 320          "post"
 321          "repost"
 322          "sca" "scal" "scala" "scalar"
 323          "u" "un" "unh" "unho" "unhol" "unhold"
 324          )
 325         font-lock-type-face)
 326       "\\b"
 327       ))
 328    ;; the gph commands
 329    (eval-when-compile
 330      (make-regexps
 331       "[ \t]+"
 332       '((
 333          "gph"
 334          ) font-lock-reference-face)
 335       "[ \t]+"
 336       '((
 337          "arc"
 338          "box"
 339          "clear" "close"
 340          "font"
 341          "line"
 342          "open"
 343          "pen" "point"
 344          "text"
 345          "vline" "vpoint" "vpoly" "vtext"
 346          )
 347         font-lock-type-face)
 348       "\\b"
 349       ))
 350
 351    ;; some of the matrix commands
 352    (eval-when-compile
 353      (make-regexps
 354       "[ \t]+"
 355       '(("mat" "matr" "matri" "matrix") font-lock-reference-face)
 356       "[ \t]+"
 357       '(("ac" "acc" "accu" "accum"
 358          "cole" "coleq"
 359          "coln" "colna" "colnam" "cloname" "colnames"
 360          "d" "def" "defi" "defin" "define"
 361          "di" "dir" "dispCns" "drop" "drop _all"
 362          "glsa" "glsac" "glsacc" "glsaccu" "glsaccum"
 363          "l" "li" "lis" "list" "makeCns" "mlou" "mlout" "post"
 364          "rowe" "roweq"
 365          "rown" "rowna" "rownam" "rowname" "rownames"
 366          "sco" "scor" "score"
 367          "sub" "subs" "subst" "substi" "substit" "substitu" "substitut" "substitute"
 368          "svd" "syme" "symei" "symeig" "symeige" "symeigen"
 369          "veca" "vecac" "vecacc" "vecaccu" "vecaccum"
 370          )
 371         font-lock-type-face)
 372       "\\b"
 373       ))
 374    ;; the ml commands
 375    (eval-when-compile
 376      (make-regexps
 377       "[ \t]+"
 378       '(("ml") font-lock-reference-face)
 379       "[ \t]+"
 380       '(("b" "be" "beg" "begi" "begin"
 381          "check" "count"
 382          "de" "dep" "depn" "depna" "depnam" "depname" "depnames"
 383          "di" "dis" "disp" "displ" "displa" "display"
 384          "f" "fu" "fun" "func" "funct" "functi" "functio" "function"
 385          "gr" "gra" "grap" "graph"
 386          "init"
 387          "max" "maxi" "maxim" "maximi" "maximiz" "maximize"
 388          "me" "met" "meth" "metho" "method"
 389          "ml" "mlo" "mlou" "mlout"
 390          "mo" "mod" "mode" "model"
 391          "pl" "plo" "plot"
 392          "po" "pos" "post"
 393          "q" "qu" "que" "quer" "query"
 394          "re" "rep" "repo" "repor" "report"
 395          "sa" "sam" "samp" "sampl" "sample"
 396          "se" "sea" "sear" "searc" "search"
 397          "trace")
 398         font-lock-type-face)
 399       "\\b"
 400       ))
 401    ;; the net commands
 402    (eval-when-compile
 403      (make-regexps
 404       "[ \t]+"
 405       '(("net") font-lock-reference-face)
 406       "[ \t]+"
 407       '((
 408          "cd"
 409          "d" "de" "des" "desc" "descr" "descri" "describ" "describe"
 410          "from" "get" "install"
 411          "link"
 412          "q" "qu" "que" "quer" "query")
 413         font-lock-type-face)
 414       "\\b"
 415       ))
 416    (eval-when-compile
 417      (make-regexps
 418       "[ \t]+"
 419       '(("net") font-lock-reference-face)
 420       "[ \t]+"
 421       '(("set") font-lock-reference-face)
 422       "[ \t]+"
 423       '(("ado" "other") font-lock-type-face)
 424       "\\b"
 425       ))
 426    (eval-when-compile
 427      (make-regexps
 428       "[ \t]+"
 429       '(("ado") font-lock-reference-face)
 430       "[ \t]+"
 431       '(("d" "de" "des" "desc" "descr" "descri" "describ" "describe"
 432          "dir"
 433          "uninstall")
 434         font-lock-type-face)
 435       "\\b"
 436       ))
 437    ;; the reshape commands
 438    (eval-when-compile
 439      (make-regexps
 440       "[ \t]+"
 441       '(("reshape") font-lock-keyword-face)
 442       "[ \t]+"
 443       '((
 444          "clear"
 445          "error"
 446          "i" "j"
 447          "long"
 448          "wide"
 449          "xi" "xij")
 450         font-lock-type-face)
 451       "\\b"
 452       ))
 453    ;; the return commands
 454    (eval-when-compile
 455      (make-regexps
 456       "[ \t]+"
 457       '(("ret" "retu" "retur" "return") font-lock-reference-face)
 458       "[ \t]+"
 459       '(("add" "clear" "local" "matrix" "scalar") font-lock-type-face)
 460       "\\b"
 461       ))
 462    (eval-when-compile
 463      (make-regexps
 464       "[ \t]+"
 465       '(("sret" "sretu" "sretur" "sreturn") font-lock-reference-face)
 466       "[ \t]+"
 467       '(("clear" "local") font-lock-type-face)
 468       "\\b"
 469       ))
 470    ;; the sts commands
 471    (eval-when-compile
 472      (make-regexps
 473       "[ \t]+"
 474       '(("sts") font-lock-reference-face)
 475       "[ \t]+"
 476       '((
 477          "g"
 478          "gen" "gene" "gener" "genera" "generat" "generate"
 479          "gr" "gra" "grap" "graph"
 480          "l" "li" "lis" "list"
 481          "t" "te" "tes" "test"
 482          )
 483         font-lock-type-face)
 484       "\\b"
 485       ))
 486    ;; the sw commands
 487    (eval-when-compile
 488      (make-regexps
 489       "[ \t]+"
 490       '(("sw") font-lock-reference-face)
 491       "[ \t]+"
 492       '((
 493          "cloglog" "cnreg" "cox" "ereg" "gamma" "glm" "gompertz" "hetprob"
 494          "llogist" "lnormal" "logistic" "logit" "ologit" "oprobit"
 495          "poisson" "probit" "qreg" "reg" "regr" "regre" "regres" "regress"
 496          "scobit" "tobit" "weibull"
 497          )
 498         font-lock-type-face)
 499       "\\b"
 500       ))
 501    ;; the window commands
 502    (eval-when-compile
 503      (make-regexps
 504       "[ \t]+"
 505       '((
 506          "win" "wind" "windo" "window"
 507          ) font-lock-reference-face)
 508       "[ \t]+"
 509       '((
 510          "d"
 511          "di" "dia" "dial" "dialo" "dialog"
 512          "dir" "drop"
 513          "fo" "fop" "fope" "fopen"
 514          "fs" "fsa" "fsav" "fsave"
 515          "l" "list"
 516          "push"
 517          "stop" "stopb" "stopbo" "stopbox"
 518          ) font-lock-type-face)
 519       "\\b"
 520       ))
 521    ;; the window controls
 522    (eval-when-compile
 523      (make-regexps
 524       "[ \t]+"
 525       '((
 526          "win" "wind" "windo" "window"
 527          ) font-lock-reference-face)
 528       "[ \t]+"
 529       '((
 530          "c" "co" "con" "cont" "contr" "contro" "control"
 531          ) font-lock-reference-face)
 532       '((
 533          "button" "check" "clear"
 534          "edit"
 535          "mcombo" "msimple"
 536          "radbegin"
 537          "radend"
 538          "radio"
 539          "scombo"
 540          "ssimple"
 541          "static"
 542          ) font-lock-type-face)
 543       "\\b"
 544       ))
 545    ;; the window manage commands
 546    (eval-when-compile
 547      (make-regexps
 548       "[ \t]+"
 549       '((
 550          "win" "wind" "windo" "window"
 551          ) font-lock-reference-face)
 552       "[ \t]+"
 553       '((
 554          "man" "mana" "manag" "manage"
 555          ) font-lock-reference-face)
 556       "[ \t]+"
 557       '((
 558          "forward"
 559          "minimize"
 560          "prefs load"
 561          "prefs save"
 562          "prefs default"
 563          "print graph"
 564          "print log"
 565          "restore"
 566          "update variable"
 567          )
 568         font-lock-type-face)
 569       "\\b"
 570       ))
 571    ;; the window menu commands
 572    (eval-when-compile
 573      (make-regexps
 574       "[ \t]+"
 575       '((
 576          "win" "wind" "windo" "window"
 577          ) font-lock-reference-face)
 578       "[ \t]+"
 579       '((
 580          "m" "me" "men" "menu"
 581          ) font-lock-reference-face)
 582       "[ \t]+"
 583       '((
 584          "append popout"
 585          "append string"
 586          "append separator"
 587          "clear"
 588          "popout"
 589          "set"
 590          )
 591         font-lock-type-face)
 592       "\\b"
 593       ))
 594    ;; the xwindow commands
 595    (eval-when-compile
 596      (make-regexps
 597       "[ \t]+"
 598       '((
 599          "xwin" "xwind" "xwindo" "xwindow"
 600          ) font-lock-reference-face)
 601       "[ \t]+"
 602       '((
 603          "de" "def" "defi" "defin" "define"
 604          "di" "dir"
 605          "drop"
 606          "l" "li" "lis" "list"
 607          )
 608         font-lock-type-face)
 609       "\\b"
 610       ))
 611
 612    ;; all the endless Stata keywords (not in a good order)
 613    ;; first those keywords which must start line
 614    ;; note that these will look like text if preceded by a comment
 615    ;; (but comments shouldn't be before the command, anyway)
 616
 617    (eval-when-compile
 618      (make-regexps
 619       "^[ \t]+"
 620       '((
 621          "cap" "capt" "captu" "captur" "capture"
 622          "char" "err" "erro" "error" "e" "ex" "exi" "exit"
 623          "par" "pars" "parse"
 624          "set"
 625          ) font-lock-reference-face)
 626       "\\b"
 627       ))
 628    ;; here are some keywords which appear in the middle of lines
 629    ;; note that the really short abbreviations could make a mess of things
 630    ;;
 631    ;; These are split to allow compiling!
 632    (eval-when-compile
 633      (make-regexps
 634       "\\b"
 635       '((
 636          "_huber" "_qreg" "_robust"
 637          "acprplot" "adjust"
 638          "adopath" "alpha"
 639          "an" "ano" "anov" "anova" "arch"
 640          "areg" "arima"
 641          "as" "ass" "asse" "asser" "assert"
 642          "avplot" "avplots"
 643          "bcskew0"
 644          "be" "bee" "beep"
 645          "biprobit" "bitest" "bitesti" "blogit"
 646          "boxcox" "bprobit" "br" "break" "brier"
 647          "bro" "brow" "brows" "browse"
 648          "bsqreg" "bstat" "by"
 649          "canon" "cat" "cc" "cci" "cchart" "centile" "cf" "ci" "cii"
 650          "clogi" "clogit" "clogitp" "cloglog"
 651          "close" "cmdtool"
 652          "cnr" "cnre" "cnreg" "cnsreg" "codebook" "compare"
 653          "copy"
 654          "cor" "corc" "corr" "corre" "correl" "correla" "correlat" "correlate"
 655          "corrgram"
 656          "cou" "coun" "count"
 657          "cox"  "cprplot" "_crcswxx" "cs" "csi"
 658          "ct" "ctset" "cttost"
 659          "cumul" "cusum")
 660         font-lock-reference-face)
 661       "\\b"
 662       ))
 663    (eval-when-compile
 664      (make-regexps
 665       "[ \t]+"
 666       '((
 667          "d" "de" "des" "desc" "descr" "descri" "describ" "describe"
 668          "dfbeta" "dfuller" "di"
 669          "dir" "dis" "disp" "disp_res" "disp_s"
 670          "displ" "displa" "display"
 671          "do" "dotplot"
 672          "dprobit" "ds" "dstdize" "dwstat"
 673          "eivreg" "eq" "ereg"
 674          "fac" "fact" "facto" "factor"
 675          "fit" "for" "fpredict"
 676          "fracplot" "fracpoly" "fsl"
 677          ) font-lock-reference-face)
 678       "\\b"
 679       ))
 680    (eval-when-compile
 681      (make-regexps
 682       "[ \t]+"
 683       '((
 684          "gettoken" "gladder" "glm" "glmpred" "glogit" "gnbreg" "gompertz"
 685          "gphdot" "gphpen" "graph" "gprobit" "greigen" "grmeanby"
 686          "hadimvo" "hausman" "heckman" "heckprob" "hetprob" "hettest" "hilite"
 687          "hist" "hlu" "hotel"
 688          "iqreg" "istdize" "iis"
 689          "ins" "insp" "inspe" "inspec" "inspect"
 690          "integ" "intreg" "ir" "iri" "ivreg"
 691          "kap" "kappa" "kapwgt" "kdensity" "ksm" "ksmirnov" "ktau"
 692          "kwallis"
 693          ) font-lock-reference-face)
 694       "\\b"
 695       ))
 696    (eval-when-compile
 697      (make-regexps
 698       "[ \t]+"
 699       '((
 700          "l" "ladder" "lfit" "lincom" "linktest"
 701          "li" "lis" "list"
 702          "log"
 703          "logistic"
 704          "logi" "logit"
 705          "loneway" "lookfor"
 706          "lo" "loo" "look" "looku" "lookup"
 707          "lpredict" "lroc" "lrtest" "ls" "lsens" "lstat" "ltable" "lv" "lvr2plot"
 708          "man" "matcproc" "mcc" "mcci"
 709          "means"
 710          "mlog" "mlogi" "mlogit"
 711          "mor" "more"
 712          "mvreg" "mx_param"
 713          "n" "nbreg" "newey" "news"
 714          "nl" "nlinit"
 715          "no" "noi" "nois" "noisi" "noisil" "noisily"
 716          "note" "notes"
 717          "nptrend" "numlist"
 718          "olog" "ologi" "ologit"
 719          "ologitp"
 720          "on" "one" "onew" "onewa" "oneway"
 721          "oprob" "oprobi" "oprobit"
 722          "oprobitp"
 723          "orthog" "orthpoly"
 724          "ovtest")
 725         font-lock-reference-face)
 726       "\\b"
 727       ))
 728    (eval-when-compile
 729      (make-regexps
 730       "[ \t]+"
 731       '(("pac" "pchart" "pchi" "pcorr" "pergram"
 732          "pl" "plo" "plot"
 733          "pnorm" "poisgof" "poisson" "pperron"
 734          "prais"
 735          "prob" "probi" "probit"
 736          "prtest" "prtesti"
 737          "pwcorr" "pwd"
 738          "q" "qchi" "qnorm" "qqplot" "qreg" "quadchk" "quantile"
 739          "qu" "que" "quer" "query"
 740          "qui" "quie" "quiet" "quietl" "quietly"
 741          "ranksum" "rchart" "regdw" "regph"
 742          "reg" "reg3" "regr" "regre" "regres" "regress" "reshape"
 743          "rot" "rota" "rotat" "rotate"
 744          "rreg"
 745          "run" "runtest" "rvfplot" "rvpplot"
 746          ) font-lock-reference-face)
 747       "\\b"
 748       ))
 749    (eval-when-compile
 750      (make-regexps
 751       "[ \t]+"
 752       '((
 753          "sampsi" "sconfirm"
 754          "sco" "scobit" "scor" "score"
 755          "sdtest" "sdtesti" "search" "serrbar"
 756          "sfrancia" "shell" "shelltool" "shewhart" "signrank" "signtest"
 757          "sktest" "slog" "spearman" "spikeplt" "sqreg"
 758          "st" "st_is" "st_show" "st_ct"
 759          "stcox" "stcoxkm" "stcurv" "stdes"
 760          "stem"
 761          "stereg" "stir" "stmc" "stmh" "stphplot" "stphtest"
 762          "strate" "streg"
 763          "sts" "stse" "stset" "stsum" "stvary" "stweib"
 764          "su" "sum" "summ" "summa" "summar" "summari" "summariz" "summarize"
 765          "sureg"
 766          "svydes" "svyintrg" "svyivreg" "svylc" "svylogit"
 767          "svymean" "svymean" "svymlog" "svyolog" "svyoprob" "svypois" "svyprobt"
 768          "svyprop" "svyratio" "svyreg" "svyset" "svytab" "svytest" "svytotal"
 769          "swilk" "symmetry" "symmi" "symplot" "syntax" "sysdir"
 770          ) font-lock-reference-face)
 771       "\\b"
 772       ))
 773    (eval-when-compile
 774      (make-regexps
 775       "[ \t]+"
 776       '((
 777          "ta" "tab"
 778          "tab1" "tab2"
 779          "tabdisp"
 780          "tabi"
 781          "table"
 782          "tabu" "tabul" "tabula" "tabulat" "tabulate"
 783          "te" "tes" "test"
 784          "testnl" "testparm" "tis"
 785          "tob" "tobi" "tobit"
 786          "token" "tokeni" "tokeniz" "tokenize"
 787          "touch" "tsreport" "tsset" "tsunab" "ttest" "ttesti"
 788          "ty" "typ" "type"
 789          "unab" "using"
 790          "vce"
 791          "verinst" "vif" "vwls"
 792          "weibull" "which" "who" "wntestb" "wntestq"
 793          "xchart" "xcorr"
 794          "xtclog" "xtdes" "xtgee" "xtgls" "xthaus" "xtintreg"
 795          "xtlogit" "xtnbreg" "xtpois" "xtprobit"
 796          "xtrchh" "xtreg" "xtsum" "xttab" "xttest0" "xttobit" "xttrans"
 797          "zip" "zinb"
 798          ) font-lock-reference-face)
 799       "\\b"
 800       ))
 801
 802    ;; conditional statements
 803    ;; if might not work right ('cuz it is also a keyword)
 804    (eval-when-compile
 805      (make-regexps
 806       "^[ \t]*\\sw+[ \t]*"
 807       '(("if"
 808          ) font-lock-reference-face t t)
 809       "\\b"
 810       ))
 811
 812    (eval-when-compile
 813      (make-regexps
 814       "^[ \t]*"
 815       '(("if" "while"
 816          ) font-lock-reference-face t t)
 817       "[ \t]+.*{"
 818       ))
 819    ;; else statement (which must just have a {)
 820    (eval-when-compile
 821      (make-regexps
 822       "^[ \t]*"
 823       '(("else"
 824          ) font-lock-reference-face)
 825       "[ \t]*{"
 826       ))
 827
 828    ;; short version of list --- which can get fooled if used as a var
 829    (eval-when-compile
 830      (make-regexps
 831       '(("^[ \t]*l\\b"
 832          ) font-lock-reference-face)
 833       ))
 834
 835    ;; all the Stata options
 836    ;; commonly used options
 837    (eval-when-compile
 838      (make-regexps
 839       "[ \t]+"
 840       '(("byte" "int" "long" "str[1-9]+[0-9]?" "float" "double"
 841          "width" "maxobs" "maxvar"
 842          ) font-lock-type-face)
 843       "[ \t]+"
 844       ))
 845    ;; special local variables (used in parsing)
 846    (eval-when-compile
 847      (make-regexps
 848       "^[ \t]+\\(local\\)+[ \t]+"
 849       '(("varlist" "exp" "weight" "if" "in" "using" "options"
 850          ) font-lock-type-face nil t t)
 851       "\\b"
 852       ))
 853
 854    ;; things used with display
 855    ;; since these are often split across lines, and Stata commands are hard
 856    ;; to delimit, this will highlight even if out of context
 857
 858    (eval-when-compile
 859      (make-regexps
 860       "[ \t]+"
 861       '((
 862          "_c" "_co" "_con" "_cont" "_conti" "_contin" "_continu" "_continue"
 863          "_n" "_ne" "_new" "_newl" "_newli" "_newlin" "_newline"
 864          "_quote"
 865          "_r" "_re" "_req" "_requ" "_reque" "_reques" "_request"
 866          )
 867         font-lock-type-face)
 868       "\\b"
 869       ))
 870    (eval-when-compile
 871      (make-regexps
 872       "[ \t]+"
 873       '((
 874          "_col" "_colu" "_colum" "_column"
 875          "_d" "_du" "_dup"
 876          "_s" "_sk" "_ski" "_skip"
 877          )
 878         font-lock-type-face)
 879       "([1-9]+[0-9]*)\\b"
 880       ))
 881    (eval-when-compile
 882      (make-regexps
 883       "\\bin[ \t]+"
 884       '((
 885          "b" "bl" "blu" "blue"
 886          "g" "gr" "gre" "gree" "green"
 887          "r" "re" "red"
 888          "w" "wh" "whi" "whit" "white"
 889          "y" "ye" "yel" "yell" "yello" "yellow"
 890          ) font-lock-type-face)
 891       "\\b"
 892       ))
 893
 894    ;; labels
 895    (eval-when-compile
 896      (make-regexps
 897       "[ \t]+"
 898       '(("lab" "labe" "label"
 899          ) font-lock-reference-face t)
 900       "[ \t]+"
 901       '((
 902          "da" "dat" "data"
 903          "de" "def" "defi" "defin" "define"
 904          "di" "dir"
 905          "drop"
 906          "l" "li" "lis" "list"
 907          "save"
 908          "val" "valu" "value" "values"
 909          "var" "vari" "varia" "variab" "variabl" "variable"
 910          ) font-lock-type-face nil t t)
 911       "[ \t]"
 912       ))
 913
 914    ;; all Stata data-altering stuff
 915    (eval-when-compile
 916      (make-regexps
 917       "\\b"
 918       '((
 919          "_pctile" "_predict"
 920          "aorder" "append"
 921          "bcskew0" "bsample" "bs" "bstrap"
 922          "cd" "chdir" "clear" "compress"
 923          "contract" "convert" "cross"
 924          "dec" "deco" "decod" "decode"
 925          "discard" "drop" "dydx"
 926          "ed" "edi" "edit" "egen"
 927          "en" "enc" "enco" "encod" "encode"
 928          "erase"
 929          "expand"
 930          "fillin"
 931          "form" "forma" "format"
 932          "fracgen" "fracpred"
 933          "g" "ge" "gen" "gene" "gener" "genera" "generat" "generate"
 934          "gsort"
 935          "impute"
 936          "infile" "infix" "input" "insheet" "integ" "ipolate"
 937          "joinby"
 938          "keep"
 939          "lnskew0"
 940          ) font-lock-keyword-face)
 941       "\\b"
 942       ))
 943    (eval-when-compile
 944      (make-regexps
 945       "\\b"
 946       '((
 947          "mark" "markout" "marksample"
 948          "matname"
 949          "mer" "merg" "merge"
 950          "mkdir" "mkmat" "mkspline"
 951          "mleval" "mlmatsum" "mlsum""mlvecsum"
 952          "modify" "mov" "move"
 953          "mvdecode" "mvencode" "nlpred" "nobreak" "order"
 954          "ou" "out" "outf" "outfi" "outfil" "outfile"
 955          "outs" "outsh" "outshe" "outshee" "outsheet"
 956          "pctile"
 957          "post" "postclose" "postfile"
 958          "pre" "pred" "predi" "predic" "predict"
 959          "preserve" "range"
 960          "recast" "recode"
 961          "ren" "rena" "renam" "rename"
 962          "renpfix" "replace" "restore" "rm"
 963          "sappend"
 964          "sa" "sav" "save"
 965          "sample" "sdrop"
 966          "separate"
 967          "simul" "sinfile" "smerge"
 968          "smooth" "snapspan"
 969          "so" "sor" "sort"
 970          "ssave" "ssort" "stack"
 971          "stbase" "stfill" "stgen" "stjoin" "stsplit" "sttocc" "sttoct"
 972          "suse" "svmat"
 973          "tsfill" "tsrevar"
 974          "u" "us" "use"
 975          "xi" "xi:" "xtile" "xpose"
 976          "xtdata" "xtpred"
 977          ) font-lock-keyword-face)
 978       "\\b"
 979       ))
 980
 981    ;; assignment of macros
 982    (eval-when-compile
 983      (make-regexps
 984       "^[ \t]*"
 985       '(("global" "local" "scalar"
 986          ) font-lock-reference-face)
 987       '(("\\([ \t]+[a-zA-Z_]+[a-zA-Z_0-9]*\\b\\)?"
 988          ) font-lock-variable-name-face t)
 989       ))
 990    ;; choosing temp names
 991    (eval-when-compile
 992      (make-regexps
 993       "^[ \t]*"
 994       '(("tempname" "tempfile" "tempvar"
 995          ) font-lock-reference-face)
 996       '(("\\([ \t]+[a-zA-Z_]+[a-zA-Z_0-9`']*\\)+"
 997          ) font-lock-type-face t)
 998       ))
 999    ;; all variable/macro stuff (put late so it will override)
1000    ;; internal constants
1001    (eval-when-compile
1002      (make-regexps
1003       "[^a-zA-Z]"
1004       '(("_merge" "_n" "_pi" "_rc" "_N"
1005          ) font-lock-variable-name-face)
1006       "[^a-zA-Z]"
1007       ))
1008    ;; some generated vars
1009    (eval-when-compile
1010      (make-regexps
1011       '(("_result([1-9]+)"
1012          ) font-lock-variable-name-face)
1013       ))
1014    ;; global macros
1015    (eval-when-compile
1016      (make-regexps
1017       '(("\\$[a-zA-Z_*]+[a-zA-Z_0-9]*"
1018          ) font-lock-variable-name-face t)
1019       ))
1020    ;; local macros
1021    (eval-when-compile
1022      (make-regexps
1023       "`+"
1024       '(("[a-zA-Z_`*]+[a-zA-Z_0-9]*"    ;has glitch interior ` is highlighted
1025          ) font-lock-variable-name-face t)
1026       "'+"
1027       ))
1028    ;; other macro commands
1029    (eval-when-compile
1030      (make-regexps
1031       "[ \t]*"
1032       '((
1033          "ma" "mac" "macr" "macro"
1034          ) font-lock-reference-face)
1035       "[ \t]+"
1036       '((
1037          "de" "def" "define"
1038          "di" "dir"
1039          "drop"
1040          "l" "li" "lis" "list"
1041          "s" "sh" "shi" "shif" "shift"
1042          )
1043         font-lock-type-face)
1044       "[ \t]+"
1045       ))
1046    ;; stata 'functions' i.e. things which require () after them
1047    (eval-when-compile
1048      (make-regexps
1049       "\\b"
1050       '(("_caller"
1051          "abs" "acos" "asin" "atan" "autocode"
1052          "Binomial"
1053          "binorm"
1054          "chiprob" "comb" "cond" "cos"
1055          "d" "date" "digamma" "day"
1056          "dofh" "dofm" "dofq" "dofw" "dofy" "dow" "doy"
1057          "e" "exp"
1058          "float" "fprob" "gammap" "get" "group"
1059          "h" "halfyear" "halfyearly" "hofd"
1060          "ibeta" "index" "int"
1061          "invbinomial" "invchi" "invfprob" "invgammap" "invnchi" "invnorm" "invt"
1062          "length" "ln" "lnfact" "lngamma" "log" "log10" "lower" "ltrim"
1063          "m" "matrix" "max" "mdy" "min" "missing" "mod" "mofd" "month" "monthly"
1064          "nchi" "normd" "normprob" "npnchi"
1065          "q" "qofd" "quarter" "quarterly"
1066          "r" "real" "recode" "reldif" "replay" "return" "round" "rtrim"
1067          "s" "scalar" "sign" "sin" "sqrt" "string" "substr" "sum"
1068          "tan" "tprob" "trigamma" "trim"
1069          "uniform" "uniform0" "upper"
1070          "w" "week" "weekly" "wofd"
1071          "y" "year" "yearly" "yh" "ym" "yofd" "yq" "yw"
1072          )
1073         font-lock-reference-face t)
1074       "("
1075       ))
1076    ;; stata 'functions' i.e. things which require [] after them
1077    (eval-when-compile
1078      (make-regexps
1079       "\\b"
1080       '(("_b" "_coef" "_se")
1081         font-lock-reference-face t)
1082       "\\["
1083       ))
1084    ;; common Stata options which require a () after them
1085    (eval-when-compile
1086      (make-regexps
1087       "[, \t]+"
1088       '(("bands" "by" "connect" "density" "gap" "iterate" "ltolerance" "margin"
1089          "psize" "saving" "tlabel" "tolerance"
1090          "xlabel" "xscale" "ylabel" "yscale")
1091         font-lock-type-face t)
1092       "("
1093       ))
1094    ;; egen 'function' options
1095    (eval-when-compile
1096      (make-regexps
1097       "[ \t]*egen[ \t]+.*=[ \t]*"
1098       '(("count" "diff" "fill" "group" "iqr"
1099          "ma" "max" "mean" "median" "min" "mtr" "pctile"
1100          "rank" "rfirst" "rlast" "rmax" "rmean" "rmin" "rmiss" "robs" "rsd" "rsum"
1101          "sd" "std" "sum")
1102         font-lock-reference-face t)
1103       "(.*)"
1104       ))
1105    ;; All Custom ado files which are 'reliable' and which are not file killers
1106    ;; this might be a useless endeavor --- but I cannot generate tag files
1107    ;; all the s-extensions are listed under Stata's name (since they alter
1108    ;; data and will be moved tot he utils directory
1109    (eval-when-compile
1110      (make-regexps
1111       "[ \t]*"
1112       '(("addnote" "anypath" "autolab" "checkvar" "ck1icd9" "ckicd9"
1113          "datetoe" "dattomdy" "den2dem" "dishis" "dtapath" "dupclean" "echo"
1114          "exdupbil" "ezip2hsa" "getdate" "getlbl" "getnames" "getobs" "gplur"
1115          "icd9" "issorted" "isfile" "jultoe" "jultof" "jultomdy" "knowndup"
1116          "labeldir" "linker"
1117          "markit" "makewide" "missize" "mpcounts"
1118          "nodups" "notefile" "prov2zip"
1119          "qcolsum" "qorder"
1120          "random" "readraw" "readzip" "repart"
1121          "setup" "stdrate"
1122          "timeslot"
1123          "wdatetoe" "wdatomdy" "zip2ezip"
1124          "_addext" "_brclean" "_brckado" "_brdlog"
1125          "_ckbad" "_ckdunno" "_ckdupl" "_ckmiss" "_ckok" "_ckwarn"
1126          "_delimit" "_filenm" "_lookup" "_mk_ck"
1127          ) font-lock-function-name-face)
1128       "\\b"
1129       ))
1130    ))
1131
1132
1133 (defvar ess-STA-mode-font-lock-keywords (ado-set-font-lock-keywords)
1134   "Set the Stata mode font-lock keywords to Bill Rising's ado-mode keywords.")
1135
1136 (defvar STA-editing-alist
1137   '((paragraph-start              . (concat "^$\\|" page-delimiter))
1138     (paragraph-separate           . (concat "^$\\|" page-delimiter))
1139     (paragraph-ignore-fill-prefix . t)
1140     (require-final-newline        . t)
1141     (comment-start                . "/\* ")
1142     (comment-end                  . " \*/")
1143     (comment-start-skip           . "/\\*+ *")
1144     (comment-column               . 40)
1145     ;;(comment-indent-function      . 'S-comment-indent)
1146     ;;(ess-comment-indent           . 'S-comment-indent)
1147     ;;(ess-indent-line              . 'S-indent-line)
1148     ;;(ess-calculate-indent         . 'S-calculate-indent)
1149     (indent-line-function         . 'S-indent-line)
1150     (parse-sexp-ignore-comments   . t)
1151     (ess-set-style                . ess-default-style)
1152     (ess-local-process-name       . nil)
1153     ;;(ess-keep-dump-files          . 'ask)
1154     (ess-mode-syntax-table        . STA-syntax-table)
1155     (font-lock-defaults           . '(ess-STA-mode-font-lock-keywords
1156                                       nil nil ((?\. . "w")))))
1157   "General options for editing Stata do and ado source files.")
1158
1159 ;; YOU USED TO HAVE TO (with Thomas's version):
1160 ;;;;; Add the following to your .emacs file
1161 ;;
1162 ;;(autoload 'stata "~/essl-sta.el" "inferior stata mode" t )
1163 ;;(autoload 'stata-help "stata" "stata help mode" t)
1164 ;;(autoload 'stata-mode "~/essl-sta.el" "stata mode" t)
1165 ;;
1166 ;;(if (assoc "\\.do$" auto-mode-alist) nil
1167 ;;  (setq auto-mode-alist
1168 ;;      (append
1169 ;;       '(("\\.do$" . stata-mode)
1170 ;;         ("\\.ado$" . stata-mode))
1171 ;;       auto-mode-alist)))
1172 ;;
1173
1174
1175 ;; QUESTIONS TO ASK THOMAS:
1176 ;; 1 - are 'help' and 'lookup' the same?
1177 ;; 2 - what is the point of the review buffer?
1178 ;; 3 - how to quit?
1179
1180 ;;
1181 ;; NOTE: all of Thomas's functions have been left here, to be removed
1182 ;; or merged into real locations as we work on this.
1183 ;;
1184
1185
1186 ;;;;;;;;; Things to change
1187
1188 (defvar stata-switches "-q"
1189   "*Switches to apply to stata invocation.")
1190
1191 (defvar stata-profile "~/.stataprofile"
1192   "File to read on startup (nil for no file).")
1193
1194 ;;;;;;;;;;;;;;;
1195
1196 ;;(require 'comint)
1197
1198 (defun stata-help (the-subject)
1199   "Stata help in other buffer."
1200   (interactive "sHelp on: ")
1201   (let* ((stata-process (get-process "stata"))
1202          (stata-buffer (process-buffer stata-process))
1203          oldpf oldpb oldpm)
1204     (set-buffer stata-buffer)
1205     (setq oldpf (process-filter stata-process))
1206     (setq oldpb (process-buffer stata-process))
1207     (setq oldpm (marker-position (process-mark stata-process)))
1208     (save-excursion
1209       (if stata-process nil (error "Stata is not running."))
1210       (beginning-of-line)
1211       (if (looking-at ". ") nil  (error "Stata not ready."))
1212       (save-excursion
1213         (set-process-buffer stata-process (get-buffer-create "*stata help*"))
1214         (set-buffer "*stata help*")
1215         (setq buffer-read-only nil)
1216         (set-process-filter stata-process 'ordinary-insertion-filter)
1217         (erase-buffer)
1218         (process-send-string stata-process "help ")
1219         (process-send-string stata-process the-subject)
1220         (process-send-string stata-process "\n")
1221         (stata-prompt-wait stata-process)
1222         ;;(stata-help-mode)
1223         (set-buffer stata-buffer)
1224         (set-process-buffer stata-process oldpb)
1225         (set-process-filter stata-process oldpf)
1226         (set-marker (process-mark stata-process) oldpm)))
1227     (display-buffer "*stata help*")))
1228
1229 (defun stata-lookup (the-subject) "Stata lookup in other buffer"
1230   (interactive "sLook up: ")
1231   (let* ((stata-process (get-process "stata"))
1232          (stata-buffer (process-buffer stata-process))
1233          oldpf oldpb oldpm)
1234     (set-buffer stata-buffer)
1235     (setq oldpf (process-filter stata-process))
1236     (setq oldpb (process-buffer stata-process))
1237     (setq oldpm (marker-position (process-mark stata-process)))
1238     (save-excursion
1239       (if stata-process nil (error "Stata is not running."))
1240       (beginning-of-line)
1241       (if (looking-at ". ") nil  (error "Stata not ready."))
1242       (save-excursion
1243         (set-process-buffer stata-process (get-buffer-create "*stata help*"))
1244         (set-buffer "*stata help*")
1245         (setq buffer-read-only nil)
1246         (set-process-filter stata-process 'ordinary-insertion-filter)
1247         (erase-buffer)
1248         (process-send-string stata-process "lookup ")
1249         (process-send-string stata-process the-subject)
1250         (process-send-string stata-process "\n")
1251         (stata-prompt-wait stata-process)
1252         (stata-help-mode)
1253         (set-buffer stata-buffer)
1254         (set-process-buffer stata-process oldpb)
1255         (set-process-filter stata-process oldpf)
1256         (set-marker (process-mark stata-process) oldpm)))
1257     (display-buffer "*stata help*")))
1258
1259 (defun stata-variables ()
1260   "Stata variable list in other buffer."
1261   (interactive)
1262   (let* ((stata-process (get-process "stata"))
1263          (stata-buffer (if stata-process
1264                            (process-buffer stata-process)
1265                          (error "Stata is not running.")))
1266          oldpf oldpb oldpm)
1267     (set-buffer stata-buffer)
1268     (setq oldpf (process-filter stata-process))
1269     (setq oldpb (process-buffer stata-process))
1270     (setq oldpm (marker-position (process-mark stata-process)))
1271     (save-excursion
1272       (if stata-process nil (error "Stata is not running."))
1273       (beginning-of-line)
1274       (if (looking-at ". ") nil  (error "Stata not ready."))
1275        (save-excursion
1276         (set-process-buffer stata-process
1277                             (get-buffer-create "*stata variables*"))
1278         (set-process-filter stata-process 'ordinary-insertion-filter)
1279         (set-buffer "*stata variables*")
1280         (setq buffer-read-only nil)
1281         (erase-buffer)
1282         (process-send-string stata-process "desc \n ")
1283         (stata-prompt-wait stata-process)
1284         (setq buffer-read-only t)
1285         (set-buffer stata-buffer)
1286         (set-process-buffer stata-process oldpb)
1287         (set-marker (process-mark stata-process) oldpm)
1288         (set-process-filter stata-process oldpf)))
1289     (display-buffer "*stata variables*")
1290     (goto-char (point-max))))
1291
1292 (defun stata-review-window ()
1293   (interactive)
1294   (display-buffer "*stata review*"))
1295
1296 (defun stata-rehelp ()
1297   (interactive)
1298   (stata-help (current-word)))
1299
1300 ;;;; <IGNORE>
1301 ;;; This doesn't do anything at the moment.  I have vague plans of
1302 ;;; implementing a menu interface using emacs
1303 ;;;
1304 (defun stata-watch-for-menu-filter (proc string)
1305   (if (string-match "^!!!window!!!" string)
1306       (stata-handle-menu-code proc string)
1307     (comint-output-filter proc string)))
1308
1309 (defun stata-handle-menu-code (proc string)
1310    (let ((old-buffer (current-buffer)))
1311     (unwind-protect
1312         (let (moving)
1313           (set-buffer (process-buffer proc))
1314           (setq moving (= (point)
1315                           (process-mark proc)))
1316           (save-excursion
1317             ;; Insert the text, moving the process-marker.
1318             (goto-char (process-mark proc))
1319             (insert "Handling menu code\n")
1320             (set-marker (process-mark proc) (point)))
1321           (if moving (goto-char (process-mark proc))))
1322       (set-buffer old-buffer))))
1323
1324 ;;;; </IGNORE>
1325
1326 (defun stata-add-to-review-buffer (string)
1327   "Adds input to review buffer."
1328   (save-excursion
1329     (set-buffer (get-buffer-create "*stata review*"))
1330     (goto-char (point-max))
1331     (insert string)))
1332
1333 (defun stata-prompt-wait (proc &optional start-of-output)
1334   "Wait for a prompt to appear at BOL of current buffer.
1335 PROC is the stata process. Does not change point."
1336   (if start-of-output nil (setq start-of-output (point-min)))
1337   (save-excursion
1338     (while (progn
1339              ;; get output if there is some ready
1340              (accept-process-output proc 0 50)
1341              (goto-char (marker-position (process-mark proc)))
1342              (beginning-of-line)
1343              (if (< (point) start-of-output) (goto-char start-of-output))
1344              (not (looking-at "^. "))))))
1345
1346 ;;(defvar inferior-stata-mode-map nil
1347 ;;  "Keymap for Stata mode")
1348
1349 ;;(setq inferior-stata-mode-map (cons 'keymap comint-mode-map))
1350 ;;(define-key inferior-stata-mode-map "\M-\t" 'comint-replace-by-expanded-filename)
1351 ;;(define-key inferior-stata-mode-map "\C-c\C-v" 'stata-variables)
1352 ;;(define-key inferior-stata-mode-map "\C-c\C-h" 'stata-help)
1353 ;;(define-key inferior-stata-mode-map "\C-c\C-u" 'stata-lookup)
1354 ;;(define-key inferior-stata-mode-map "\C-c\C-r"   'stata-review-window)
1355 ;;(define-key inferior-stata-mode-map [menu-bar stata]
1356 ;;  (cons "Stata" (make-sparse-keymap "Stata")))
1357 ;;(define-key inferior-stata-mode-map [menu-bar stata statahelp]
1358 ;;  '("Help on..." . stata-help))
1359 ;;(define-key inferior-stata-mode-map [menu-bar stata lookup]
1360 ;;  '("Look up..." . stata-lookup))
1361 ;;(define-key inferior-stata-mode-map [menu-bar stata variables]
1362 ;;  '("Variables" . stata-variables))
1363 ;;(define-key inferior-stata-mode-map [menu-bar stata review]
1364 ;;  '("Review" . stata-review-window))
1365
1366
1367 ;;(defvar stata-mode-map nil
1368 ;;  "Keymap for Stata mode")
1369
1370 ;;(setq stata-mode-map (make-sparse-keymap))
1371 ;;(define-key stata-mode-map "\C-c\C-r"    'stata-eval-region)
1372 ;;(define-key stata-mode-map "\C-c\M-r" 'stata-eval-region-and-go)
1373 ;;(define-key stata-mode-map "\C-c\C-b"    'stata-eval-buffer)
1374 ;;(define-key stata-mode-map "\C-c\M-b" 'stata-eval-buffer-and-go)
1375 ;;(define-key stata-mode-map "\C-c\C-f"    'stata-eval-function)
1376 ;;(define-key stata-mode-map "\C-c\C-n"     'stata-eval-line-and-next-line)
1377 ;;(define-key stata-mode-map "\C-c\C-j"    'stata-eval-line)
1378 ;;(define-key stata-mode-map "\C-c\C-r"   'stata-review-window)
1379 ;;(define-key stata-mode-map "\C-c\M-j" 'stata-eval-line-and-go)
1380 ;;(define-key stata-mode-map "\C-c\C-y"    'stata-switch-to-stata)
1381 ;;(define-key stata-mode-map "\C-c\C-z" 'stata-switch-to-end-of-stata)
1382 ;;;;(define-key stata-mode-map "\C-c\C-l"    'stata-load-file)
1383 ;;(define-key stata-mode-map "\C-c\C-h"    'stata-help)
1384 ;;(define-key stata-mode-map "\C-c\C-v"    'stata-variables)
1385 ;;(define-key stata-mode-map "\M-\t" 'comint-replace-by-expanded-filename)
1386 ;;(define-key stata-mode-map "\177" 'backward-delete-char-untabify)
1387 ;;(define-key stata-mode-map "\C-c\C-u" 'stata-lookup)
1388 ;;(define-key stata-mode-map [menu-bar stata]
1389 ;;  (cons "Stata" (make-sparse-keymap "Stata")))
1390 ;;(define-key stata-mode-map [menu-bar stata lookup]
1391 ;;  '("Look up..." . stata-lookup))
1392 ;;(define-key stata-mode-map [menu-bar stata statahelp]
1393 ;;  '("Help on..." . stata-help))
1394 ;;(define-key stata-mode-map [menu-bar stata variables]
1395 ;;  '("Variables" . stata-variables))
1396 ;;(define-key stata-mode-map [menu-bar stata review]
1397 ;;  '("Review" . stata-review-window))
1398 ;;(define-key stata-mode-map [menu-bar stata eval-line]
1399 ;;  '("Eval line" . stata-eval-line))
1400 ;;(define-key stata-mode-map [menu-bar stata eval-next]
1401 ;;  '("Eval line and next line" . stata-eval-line-and-next-line))
1402 ;;(define-key stata-mode-map [menu-bar stata eval-go]
1403 ;;  '("Eval line and go" . stata-eval-line-and-go))
1404 ;;(define-key stata-mode-map [menu-bar stata eval-buff]
1405 ;;  '("Eval buffer" . stata-eval-buffer))
1406 ;;(define-key stata-mode-map [menu-bar stata eval-buff-go]
1407 ;;  '("Eval buffer and go" . stata-eval-buffer-and-go))
1408 ;;(define-key stata-mode-map [menu-bar stata to-stata]
1409 ;;  '("Switch to stata" . stata-switch-to-stata))
1410 ;;
1411 ;;
1412 ;;
1413
1414 ;(defvar stata-help-mode-map nil)
1415 ;(setq stata-help-mode-map (cons 'keymap help-mode-map))
1416 ;(define-key stata-help-mode-map [mouse-2] 'stata-rehelp)
1417 ;(define-key stata-help-mode-map "\C-c\C-r" 'stata-rehelp)
1418 ;(define-key stata-help-mode-map "\C-c\C-h" 'stata-help)
1419 ;(define-key stata-help-mode-map [menu-bar stata]
1420 ;  (cons "Stata" (make-sparse-keymap "Stata")))
1421 ;(define-key stata-help-mode-map [menu-bar stata statahelp]
1422 ;  '("Help on..." . stata-help))
1423 ;(define-key stata-help-mode-map [menu-bar stata rehelp]
1424 ;  '("rehelp (hyperlink)" . stata-rehelp))
1425 ;;
1426
1427
1428 ;;(defun inferior-stata-mode ()
1429 ;;"Major mode for running Stata. Based on comint-mode.
1430 ;;Features include Help (\\[stata-help]), Review (\\[stata-review-window]) and
1431 ;;Variables (\\[stata-variables]) mimicking the help, review and
1432 ;;variables windows of Stata for Windows
1433 ;;\\{inferior-stata-mode-map}"
1434 ;;  (interactive)
1435 ;;  (make-comint "stata" "stata"
1436 ;;             (and stata-profile
1437 ;;                  (or (file-exists-p stata-profile)
1438 ;;                      (null (message "Startup file %s not found."
1439 ;;                                     stata-profile))) stata-profile)
1440 ;;             stata-switches)
1441 ;;  (switch-to-buffer "*stata*" )
1442 ;;  (setq comint-process-echoes t)
1443 ;;  (set-process-filter (get-process "stata") 'stata-watch-for-menu-filter)
1444 ;;  (setq comint-input-filter-functions
1445 ;;      (cons 'stata-add-to-review-buffer comint-input-filter-functions))
1446 ;;  (save-excursion
1447 ;;    (set-buffer (get-buffer-create "*stata review*"))
1448 ;;    (stata-mode))
1449 ;;  (setq major-mode 'inferior-stata-mode)
1450 ;;  (setq mode-name "inferior Stata")
1451 ;;  (use-local-map inferior-stata-mode-map))
1452 ;;
1453 ;;(defun stata ()
1454 ;;  (interactive)
1455 ;;  (inferior-stata-mode))
1456 ;;
1457
1458 (defun stata-help-mode ()
1459   "Major mode for displaying Stata help in a read-only buffer.
1460 Active commands are Help (\\[stata-help]) and hyperlink
1461 (\\[stata-rehelp] or mouse-2)."
1462   (interactive)
1463   (setq major-mode 'stata-help-mode)
1464   (setq mode-name "Stata help")
1465   ;;(use-local-map stata-help-mode-map)
1466   (setq buffer-read-only t))
1467
1468 ;;
1469 ;;
1470 ;;(defun stata-mode ()
1471 ;;"Major mode for editing Stata files. Commands for sending lines to
1472 ;;Stata (\\[stata-eval-line], \\[stata-eval-line-and-go],
1473 ;;\\[stata-eval-line-and-next-line])
1474 ;;and for displaying Stata help (\\[stata-help]), variables (\\[stata-variables])
1475 ;; and review window (\\[stata-review-window])
1476 ;;\\{stata-mode-map}"
1477 ;;  (interactive)
1478 ;;  (kill-all-local-variables)
1479 ;;  (setq major-mode 'stata-mode)
1480 ;;  (setq mode-name "Stata")
1481 ;;  (use-local-map stata-mode-map))
1482 ;;
1483 ;;
1484 ;;(defun stata-eval-region (start end)
1485 ;;  "Send the current region to the inferior stata process."
1486 ;;  (interactive "r")
1487 ;;  (process-send-region "stata" start end)
1488 ;;  (process-send-string "stata" "\n"))
1489
1490
1491
1492 ;;(defun stata-eval-buffer ()
1493 ;;  "Send the current buffer to the inferior stata process."
1494 ;;  (interactive)
1495 ;;  (stata-eval-region (point-min) (point-max)))
1496
1497 ;;(defun stata-eval-line ()
1498 ;;  "Send the current line to the inferior stata process."
1499 ;;  (interactive)
1500 ;;  (save-excursion
1501 ;;    (end-of-line)
1502 ;;    (let ((end (point)))
1503 ;;      (beginning-of-line)
1504 ;;      (stata-eval-region (point) end))))
1505
1506 ;;(defun stata-eval-line-and-next-line ()
1507 ;;  "Evaluate the current line  and move to the next line."
1508 ;;  ;; From an idea by Rod Ball (rod@marcam.dsir.govt.nz)
1509 ;;  (interactive)
1510 ;;  (display-buffer (process-buffer (get-process "stata")))
1511 ;;  (save-excursion
1512 ;;    (end-of-line)
1513 ;;    (let ((end (point)))
1514 ;;      (beginning-of-line)
1515 ;;      ;; RDB modified to go to end of S buffer so user can see result
1516 ;;      ;;(stata-eval-visibly (buffer-substring (point) end) nil t)))
1517 ;;      (stata-eval-region (point) end)))
1518 ;;  (next-line 1))
1519
1520
1521 ;;(defun stata-eval-region-and-go (start end )
1522 ;;  "Send the current region to the inferior S and switch to the process buffer."
1523 ;;  (interactive "r\nP")
1524 ;;  (stata-eval-region start end)
1525 ;;  (stata-switch-to-stata t))
1526
1527 ;;(defun stata-eval-buffer-and-go ()
1528 ;;  "Send the current buffer to the inferior stata and switch to the process buffer."
1529 ;;  (interactive)
1530 ;;  (stata-eval-buffer)
1531 ;;  (stata-switch-to-stata t))
1532
1533
1534 ;;(defun stata-eval-line-and-go ()
1535 ;;  "Send the current line to the inferior stata process and switch to the
1536 ;;process buffer."
1537 ;;  (interactive)
1538 ;;  (stata-eval-line)
1539 ;;  (stata-switch-to-stata t))
1540
1541
1542 ;;(defun stata-switch-to-stata (eob-p)
1543 ;;  "Switch to the current inferior stata process buffer.
1544 ;;With argument, positions cursor at end of buffer."
1545 ;;  (interactive "P")
1546 ;;  (let (stata-process (get-process "stata"))
1547 ;;    (if stata-process
1548 ;;      (progn
1549 ;;        (switch-to-buffer (process-buffer stata-process))
1550 ;;        (if eob-p (goto-char (point-max))))
1551 ;;      (progn
1552 ;;      (message "No inferior stata process")
1553 ;;      (ding)))))
1554
1555 ;;(defun stata-switch-to-end-of-stata nil
1556 ;;  "Switch to the end of the inferior stata process buffer."
1557 ;;  (interactive)
1558 ;;  (stata-switch-to-stata t))
1559
1560 ;;; Suggested function from Brendan Halpin:
1561 (defvar ess-STA-delimit-do-file "delimit-do.do")
1562
1563 (defun ess-STA-delimit-do ()
1564   (save-excursion
1565     (let ((commands (buffer-substring-no-properties (region-beginning)
1566                                                     (region-end))))
1567       (set-buffer (get-buffer-create ess-STA-delimit-do-file))
1568       (delete-region (point-min) (point-max))
1569       (insert "#delimit ;\n"
1570               commands
1571               "\n#delimit cr\n")
1572       (write-file ess-STA-delimit-do-file nil)
1573       (comint-send-string "Stata"
1574                           (format "do %s \n" ess-STA-delimit-do-file)))))
1575 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1576
1577
1578 (provide 'essl-sta)
1579
1580 \f ; Local variables section
1581
1582 ;;; This file is automatically placed in Outline minor mode.
1583 ;;; The file is structured as follows:
1584 ;;; Chapters:     ^L ;
1585 ;;; Sections:    ;;*;;
1586 ;;; Subsections: ;;;*;;;
1587 ;;; Components:  defuns, defvars, defconsts
1588 ;;;              Random code beginning with a ;;;;* comment
1589
1590 ;;; Local variables:
1591 ;;; mode: emacs-lisp
1592 ;;; outline-minor-mode: nil
1593 ;;; mode: outline-minor
1594 ;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
1595 ;;; End:
1596
1597 ;;; essl-sta.el ends here
1598
1599
1600