lisp/essl-sas.el

   1 ;;; essl-sas.el --- SAS customization
   2
   3 ;; Copyright (C) 1997--2004 A.J. Rossini, Rich M. Heiberger, Martin
   4 ;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
   5
   6 ;; Original Authors: Richard M. Heiberger <rmh@astro.ocis.temple.edu>,
   7 ;;          A.J. Rossini <rossini@u.washington.edu>,
   8 ;;          Rodney Sparapani <rsparap@mcw.edu>
   9 ;; Created: 20 Aug 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 1.4 of SAS mode:
  32
  33
  34 ;;;    sas-mode:  indent, run etc, SAS programs.
  35 ;;;    Copyright (C) 1994--1997 Tom Cook
  36 ;;;  Author:   Tom Cook
  37 ;;;            Dept. of Biostatistics
  38 ;;;            University of Wisconsin - Madison
  39 ;;;            Madison, WI 53706
  40 ;;;            cook@biostat.wisc.edu
  41 ;;;
  42 ;;;  Acknowledgements:
  43 ;;;  Menu code for XEmacs/Lucid emacs and startup mods
  44 ;;;  contributed by arossini@biostats.hmc.psu.edu
  45 ;;;
  46 ;;; Last change: 2/1/95
  47 ;;; Last change: 01/15/02
  48
  49 (ess-message "[essl-sas:] (require 'ess) ...")
  50 (require 'ess)
  51 (ess-message "[essl-sas:] (require 'ess-mode) ...")
  52 (require 'ess-mode)
  53 (require 'ess-cust)
  54
  55 (ess-message "[essl-sas:] (autoload ..) (def** ..) etc ...")
  56
  57 (autoload 'ess-transcript-mode "ess-trns" "ESS source eval mode." t)
  58
  59 (put 'ess-transcript-minor-mode 'permanent-local t)
  60 (or (assq 'ess-transcript-minor-mode minor-mode-alist)
  61     (setq minor-mode-alist
  62           (append minor-mode-alist
  63                   (list '(ess-transcript-minor-mode " ESStr")))))
  64
  65 (put 'ess-listing-minor-mode 'permanent-local t)
  66 (or (assq 'ess-listing-minor-mode minor-mode-alist)
  67     (setq minor-mode-alist
  68           (append minor-mode-alist
  69                   (list '(ess-listing-minor-mode " ESSlst")))))
  70
  71 (defun ess-transcript-minor-mode (&optional arg)
  72   "Toggle Ess-Transcript minor mode.
  73 With arg, turn Ess-Transcript minor mode on if arg is positive, off
  74 otherwise.  See the command `ess-transcript-mode' for more information
  75 on this mode."
  76   (interactive "P")
  77   (setq ess-transcript-minor-mode
  78         (if (null arg) (not ess-transcript-minor-mode)
  79           (> (prefix-numeric-value arg) 0)))
  80   (force-mode-line-update)
  81   (setq mode-line-process
  82         '(" [" ess-local-process-name "]")))
  83
  84 (defun ess-listing-minor-mode (&optional arg)
  85   "Toggle Ess-Listing minor mode.
  86 With arg, turn Ess-Listing minor mode on if arg is positive, off
  87 otherwise.  Ess-Listing mode is used solely to place an indicator on
  88 the mode line."
  89   (interactive "P")
  90   (setq ess-listing-minor-mode
  91         (if (null arg) (not ess-listing-minor-mode)
  92           (> (prefix-numeric-value arg) 0)))
  93   (force-mode-line-update)
  94   (setq mode-line-process
  95         '(" [" ess-local-process-name "]")))
  96
  97 (defun SAS-log-mode ()
  98   "`ess-transcript-mode' for SAS."
  99   (interactive)
 100   (SAS-mode)
 101   (ess-transcript-minor-mode 1)
 102   (toggle-read-only t)) ;; to protect the buffer.
 103
 104 (defun SAS-listing-mode()
 105   "Fundamental mode with `ess-listing-minor-mode' and read-only."
 106   (interactive)
 107   (fundamental-mode)
 108   (ess-listing-minor-mode 1)
 109   (use-local-map sas-mode-local-map)
 110   (toggle-read-only t)) ;; to protect the buffer.
 111
 112 (fset 'sas-log-mode        'SAS-log-mode)
 113 (fset 'SAS-transcript-mode 'SAS-log-mode)
 114 (fset 'sas-transcript-mode 'SAS-log-mode)
 115 (fset 'sas-mode 'SAS-mode)
 116 (fset 'sas-listing-mode    'SAS-listing-mode)
 117
 118 (defcustom  sas-indent-width 4
 119   "*Amount to indent sas statements."
 120   :group 'ess-sas
 121   :type  'integer)
 122
 123 (defcustom sas-indent-ignore-comment "*"
 124   "*Comments that start with this string are ignored in indentation."
 125   :group 'ess-sas
 126   :type  'string)
 127
 128 (defcustom sas-require-confirmation t
 129   "*Require confirmation when revisiting a modified sas-output file."
 130   :group 'ess-sas
 131   :type  'boolean)
 132
 133 ;; user can specify the sas program name
 134 (defcustom sas-program
 135   (if (equal system-type 'Apple-Macintosh) "invoke SAS using program file" "sas")
 136   "*Command to invoke SAS, default for buffer-local `ess-sas-submit-command'."
 137   :group 'ess-sas
 138   :type  'string)
 139
 140 (defcustom sas-pre-run-hook nil
 141   "Hook to execute prior to running SAS via `submit-sas'."
 142   :group 'ess-sas
 143   :type  'hook)
 144
 145 ;never used--see ess-sas-submit-command-options in essa-sas.el
 146 ;(defcustom sas-options-string ""
 147 ;  "*Options to be passed to sas as if typed on the command line."
 148 ;  :group 'ess-sas
 149 ;  :type  'string)
 150
 151 (defcustom sas-notify t
 152   "*Beep and display message when job is done."
 153   :group 'ess-sas
 154   :type  'boolean)
 155
 156 (defcustom sas-error-notify t
 157   "*If `sas-notify' t, indicate errors in log file upon completion."
 158   :group 'ess-sas
 159   :type  'boolean)
 160
 161 (defcustom sas-get-options nil
 162   "Options to be passed to SAS in sas-get-dataset."
 163   :group 'ess-sas
 164   :type '(choice (const nil) string))
 165
 166 (defcustom sas-get-options-history nil
 167   "History list of Options passed to SAS in sas-get-dataset."
 168   :group 'ess-sas)
 169
 170 (defcustom sas-page-number-max-line 3
 171   "*Number of lines from the page break, to search for the page
 172 number."
 173   :group 'ess-sas
 174   :type  'integer)
 175
 176 (defcustom sas-notify-popup nil
 177   "*If this and sas-notify are t), popup a window when SAS job ends."
 178   :group 'ess-sas
 179   :type  'boolean)
 180
 181 (defcustom sas-tmp-libname "_tmp_"
 182   "*Libname to use for sas-get-dataset."
 183   :group 'ess-sas
 184   :type  'string)
 185
 186 (defcustom sas-file-name nil
 187   "*The name of the current sas file."
 188   :group 'ess-sas
 189   :type '(choice (const nil) file))
 190
 191 ;; The next two are ``the inside of [...] in a regexp'' to be used in
 192 ;; (skip-chars-(for|back)ward SAS-..-chars)
 193 (defcustom sas-white-chars " \t\n\f"
 194   "This does NOT escape blanks (RMH, 2000/03/20)."
 195   :group 'ess-sas
 196   :type  'string)
 197
 198 (defcustom sas-comment-chars (concat sas-white-chars ";")
 199   "Doc?"
 200   :group 'ess-sas
 201   :type  'string)
 202
 203 (defcustom ess-sas-run-make-regexp nil
 204   "If you do not want to run make-regexp, then set to nil."
 205   :group 'ess-sas
 206   :type '(choice (const nil) string))
 207
 208 (require 'essa-sas)
 209
 210 (defvar sas-buffer-name nil)
 211 (defvar sas-file-root nil)
 212 (defvar sas-submitable nil)
 213 (defvar sas-dataset nil)
 214 (defvar SAS-syntax-table nil "Syntax table for SAS code.")
 215
 216 (if SAS-syntax-table nil
 217   (setq SAS-syntax-table (make-syntax-table))
 218
 219 ;; (if (equal system-type 'windows-nt)
 220 ;;     ;; backslash is punctuation (used in MS file names)
 221 ;;     (modify-syntax-entry ?\\ "."  SAS-syntax-table)
 222 ;;    ;; backslash is an escape character
 223 ;;    (modify-syntax-entry ?\\ "\\" SAS-syntax-table))
 224 (modify-syntax-entry ?\\ "."  SAS-syntax-table)  ;; backslash is punctuation
 225 (modify-syntax-entry ?+  "."  SAS-syntax-table)
 226 (modify-syntax-entry ?-  "."  SAS-syntax-table)
 227 (modify-syntax-entry ?=  "."  SAS-syntax-table)
 228 (modify-syntax-entry ?%  "w"  SAS-syntax-table)
 229 (modify-syntax-entry ?<  "."  SAS-syntax-table)
 230 (modify-syntax-entry ?>  "."  SAS-syntax-table)
 231 (modify-syntax-entry ?&  "w"  SAS-syntax-table)
 232 (modify-syntax-entry ?|  "."  SAS-syntax-table)
 233 (modify-syntax-entry ?\' "\"" SAS-syntax-table)
 234 (modify-syntax-entry ?*  ". 23"  SAS-syntax-table) ; comment character
 235 (modify-syntax-entry ?\; "."  SAS-syntax-table)
 236 (modify-syntax-entry ?_  "w"  SAS-syntax-table)
 237 (modify-syntax-entry ?<  "."  SAS-syntax-table)
 238 (modify-syntax-entry ?>  "."  SAS-syntax-table)
 239 (modify-syntax-entry ?/  ". 14"  SAS-syntax-table) ; comment character
 240 (modify-syntax-entry ?.  "w"  SAS-syntax-table))
 241
 242 (require 'font-lock); fontification also works in terminals!
 243 ;; (if (or window-system
 244 ;;      noninteractive) ; compilation!
 245 ;;; ...
 246
 247
 248 (defvar SAS-mode-font-lock-keywords
 249   (if ess-sas-run-make-regexp
 250       (list
 251        ;; SAS comments
 252        (cons "^[ \t]*%?\\*.*;"          font-lock-comment-face)
 253        (cons ";[ \t]*%?\\*.*;"          font-lock-comment-face)
 254        (list "/\\*\\([^*/]\\)*\\*/"      0  font-lock-comment-face t)
 255
 256        ;; SAS execution blocks, DATA/RUN, PROC/RUN, %MACRO/%MEND
 257        (cons "\\<\\(data\\|run\\|%macro\\|%mend\\)\\>" font-lock-constant-face)
 258        (cons "\\<proc[ \t]+[a-z][a-z_0-9]+"            font-lock-constant-face)
 259
 260        ;; SAS statements
 261
 262        (cons (concat
 263               "\\<"
 264               "%?do[ \t]*" (make-regexp '("over" "%?until" "%?while") t) "?"
 265               "\\>")
 266              font-lock-keyword-face)
 267
 268        (cons (concat
 269               "\\<"
 270               (make-regexp
 271                '(
 272                  "abort" "array" "attrib" "by" "delete" "display" "dm"
 273                  "drop" "error" "file" "filename" "footnote\\(10?\\|[2-9]\\)?"
 274                  "format"
 275                  "%go[ \t]*to" "%if" "%then" "%else"
 276                  "go[ \t]*to" "if" "then" "else"
 277                  "infile" "informat" "input" "%input" "keep" "label"
 278                  "length" "libname" "link"
 279                  "merge" "missing" "modify" "note" "options" "goptions" "output"
 280                  "otherwise" "put" "%put" "rename" "retain" "select" "when" "set"
 281                  "skip" "title\\(10?\\|[2-9]\\)?" "where" "window" "update" "out"
 282                  "change" "class" "exchange" "exclude" "freq" "id" "index"
 283                  "model" "plot" "save" "sum" "tables?" "var" "weight" "with"
 284                  "manova" "repeated" "value" "random" "means" "lsmeans"
 285                  ;; SAS macro statements not handled above
 286                  "%global" "%include" "%local" "%let" "%sysexec"
 287                  ) t) "\\>")
 288              font-lock-keyword-face)
 289
 290        ;; SAS statements that must be followed by a semi-colon
 291        (cons (concat
 292               "\\<"
 293               (make-regexp
 294                '(
 295                  "cards4?" "end" "%end" "endsas" "list" "lostcard" "page"
 296                  "return" "stop"
 297                  ) t) "\\>" "[ \t]*;")
 298              font-lock-keyword-face)
 299
 300        ;; SAS/GRAPH statements not handled above
 301        (cons (concat
 302               "\\<"
 303               (make-regexp
 304                '("axis" "legend" "pattern" "symbol") t) "\\([1-9][0-9]?\\)?"
 305               "\\>")
 306              font-lock-keyword-face)
 307
 308        ;; SAS functions and SAS macro functions
 309        (cons "%[a-z_][a-z_0-9]*[ \t]*[(;]"
 310              font-lock-function-name-face)
 311        (cons "\\<call[ \t]+[a-z_][a-z_0-9]*[ \t]*("
 312              font-lock-function-name-face)
 313
 314        (cons (concat
 315               "\\<"
 316               (make-regexp
 317                '(
 318                  "abs" "arcos" "arsin" "atan" "betainv" "byte" "ceil" "cinv"
 319                  "collate" "compress" "cosh?" "css" "cv"
 320                  "daccdb" "daccdbsl" "daccsl" "daccsyd" "dacctab"
 321                  "depdb" "depdbsl" "depsl" "depsyd" "deptab"
 322                  "date" "datejul" "datepart" "datetime" "day" "hms" "dhms" "dif"
 323                  "digamma" "dim" "erfc?" "exp" "finv"
 324                  "fipnamel?" "fipstate" "floor" "fuzz" "gaminv" "gamma"
 325                  "hbound" "hour" "indexc?" "input" "int" "intck" "intnx" "intrr"
 326                  "irr" "juldate" "kurtosis" "lag" "lbound" "left" "length"
 327                  "lgamma" "log" "log10" "log2" "max" "mdy" "mean" "min" "minute"
 328                  "mod" "month" "mort" "n" "netpv" "nmiss" "normal" "npv"
 329 ;;;) t) "\\>" "[ \t]*(")
 330 ;;;      font-lock-function-name-face)
 331 ;;;
 332 ;;;    (cons (concat "\\<"
 333 ;;;(make-regexp '(
 334                  "probbeta" "probbnml" "probchi" "probf" "probgam" "probhypr"
 335                  "probit" "probnegb" "probnorm" "probt"
 336                  "ordinal" "poisson" "put" "qtr" "range" "rank" "repeat"
 337                  "ranbin" "rancau" "ranexp" "rangam" "rannor" "ranpoi"
 338                  "rantbl" "rantri" "ranuni"
 339                  "reverse" "right" "round" "saving" "scan" "second" "sign" "sinh?"
 340                  "sqrt" "std" "stderr" "stfips" "stnamel?" "substr" "sum"
 341                  "symget" "tanh?" "time" "timepart" "tinv" "today" "translate"
 342                  "trigamma" "trim" "trunc" "uniform" "upcase" "uss" "var"
 343                  "verify" "weekday" "year" "yyq"
 344                  "zipfips" "zipnamel?" "zipstate"
 345 ;;;) t) "\\>" "[ \t]*(")
 346 ;;;      font-lock-function-name-face)
 347 ;;;
 348 ;;;
 349 ;;;    ;; SAS functions introduced in Technical Report P-222
 350 ;;;    ;; SCL functions that are known to work with SAS macro function %sysfunc
 351 ;;;    (cons (concat "\\<"
 352 ;;;(make-regexp '(
 353                  "airy" "band" "blshift" "brshift" "bnot" "bor" "bxor"
 354                  "cnonct" "fnonct" "tnonct" "compbl" "dairy" "dequote"
 355                  "ibessel" "jbessel"
 356                  "indexw" "inputc" "inputn"  "lowcase"
 357                  "putc" "putn" "quote" "resolve" "soundex" "sysprod"
 358                  "tranwrd" "trimn"
 359                  "%sysfunc" "attrc" "attrn" "cexist" "close" "dclose" "dnum"
 360                  "dopen" "dread" "exist" "fclose" "fetchobs" "fileexist"
 361                  "finfo" "fopen" "fput" "fwrite" "getoption"
 362                  "getvarc" "getvarn" "libname" "libref" "open" "optgetn" "optsetn"
 363                  "pathname" "sysmsg" "varfmt" "varlabel" "varnum" "vartype"
 364                  ) t) "\\>" "[ \t]*(")
 365              font-lock-function-name-face)
 366        )
 367     (list
 368      ;; .log NOTE: messages
 369      (cons "^NOTE: .*$"                         font-lock-constant-face)
 370
 371      ;; .log ERROR: messages
 372      (cons "^ERROR: .*$"                        font-lock-keyword-face)
 373
 374      ;; .log WARNING: messages
 375      (cons "^WARNING: .*$"                      font-lock-function-name-face)
 376
 377      ;; SAS comments
 378      ;; /* */ handled by grammar above
 379      ;;  (list "/\\*.*\\*/"                      0  font-lock-comment-face t)
 380      (cons "\\(^[0-9]*\\|;\\)[ \t]*\\(%?\\*\\|comment\\).*\\(;\\|$\\)" font-lock-comment-face)
 381
 382      ;; SAS execution blocks, DATA/RUN, PROC/RUN, SAS Macro Statements
 383      (cons "\\<%do[ \t]*\\(%until\\|%while\\)?\\>"
 384            font-lock-constant-face)
 385      ;;(cons (concat "\\(^[0-9]*\\|;\\)[ \t]*"
 386      ;;"%\\(end\\|global\\|local\\|m\\(acro\\|end\\)\\)"
 387      ;;"\\>")                               font-lock-constant-face)
 388      (cons "\\<%\\(end\\|global\\|local\\|m\\(acro\\|end\\)\\)\\>"
 389            font-lock-constant-face)
 390
 391      (cons (concat "\\(^[0-9]*\\|;\\|):\\|%then\\|%else\\)[ \t]*"
 392                    "\\(data\\|endsas\\|finish\\|quit\\|run\\|start\\)[ \t\n;]")
 393            font-lock-constant-face)
 394      (cons (concat "\\(^[0-9]*\\|;\\|):\\|%then\\|%else\\)[ \t]*"
 395                    ;;"proc[ \t]+[a-z][a-z_0-9]+")        font-lock-constant-face)
 396                    "proc[ \t]+"
 397                    ;;SAS/Base, SAS/Graph, SAS/FSP and common add-ons
 398                    "\\(append"
 399                    "\\|c\\(a\\(lendar\\|talog\\)\\|port\\|o\\(mpare\\|ntents\\|py\\|rr\\)\\)"
 400                    "\\|d\\(atasets\\|bcstab\\|isplay\\)\\|ex\\(plode\\|port\\)"
 401                    "\\|f\\(orm\\(at\\|s\\)\\|req\\|s\\(browse\\|edit\\|l\\(etter\\|ist\\)\\|view\\)\\)"
 402                    "\\|g?\\(chart\\|p\\(lot\\|rint\\)\\)"
 403                    "\\|g\\(anno\\|contour\\|device\\|font\\|\\(key\\)?map\\|options\\|project"
 404                    "\\|re\\(duce\\|move\\|play\\)\\|slide\\|testit\\|3\\(d\\|grid\\)\\)"
 405                    "\\|[cg]?import\\|i\\(ml\\|nsight\\)\\|means\\|options\\|p\\(menu\\|rintto\\)"
 406                    "\\|r\\(ank\\|e\\(gistry\\|port\\)\\)"
 407                    "\\|s\\(ort\\|ql\\|tandard\\|ummary\\)"
 408                    "\\|t\\(abulate\\|imeplot\\|ran\\(spose\\|tab\\)\\)\\|univariate"
 409                    ;;SAS/Stat and SAS/ETS
 410                    "\\|a\\(ceclus\\|nova\\|rima\\|utoreg\\)\\|boxplot"
 411                    "\\|c\\(a\\(lis\\|n\\(corr\\|disc\\)\\|tmod\\)\\|itibase\\|luster\\|o\\(mputab\\|rresp\\)\\)"
 412                    "\\|discrim\\|expand\\|f\\(a\\(ctor\\|stclus\\)\\|orecast\\|req\\)"
 413                    "\\|g\\(enmod\\|l\\(immix\\|m\\(mod\\|power\\|select\\)?\\)\\)\\|inbreed\\|k\\(de\\|rige2d\\)"
 414                    "\\|l\\(attice\\|ife\\(reg\\|test\\)\\|o\\(ess\\|gistic\\)\\)"
 415                    "\\|m\\(ds\\|ixed\\|o\\(de\\(clus\\|l\\)\\|rtgage\\)\\|ulttest\\)"
 416                    "\\|n\\(ested\\|l\\(in\\|mixed\\)\\|par1way\\)\\|orthoreg"
 417                    "\\|p\\(dlreg\\|hreg\\|l\\(an\\|s\\)\\|ower\\|r\\(in\\(comp\\|qual\\)\\|obit\\)\\)\\|r\\(sr\\)?eg"
 418                    "\\|s\\(core\\|im\\(2d\\|lin\\)\\|pectra\\|t\\(atespace\\|dize\\|epdisc\\)\\|urvey\\(means\\|reg\\|select\\)\\|yslin\\)"
 419                    "\\|t\\(phreg\\|pspline\\|r\\(ansreg\\|ee\\)\\|test\\)"
 420                    "\\|var\\(clus\\|comp\\|iogram\\)\\|x11"
 421                    "\\)")        font-lock-constant-face)
 422
 423      ;;(cons (concat "\\(^[0-9]*\\|;\\|%then\\|%else\\)[ \t]*"
 424      ;;"\\(%\\(go[ \t]*to\\|i\\(f\\|n\\(clude\\|put\\)\\)\\|let\\|put\\|sysexec\\)\\)"
 425      ;;"\\>")                               font-lock-constant-face)
 426      (cons "\\<%\\(go[ \t]*to\\|i\\(f\\|n\\(clude\\|put\\)\\)\\|let\\|put\\|sysexec\\)\\>"
 427            font-lock-constant-face)
 428
 429      (cons "\\<%\\(by\\|else\\|t\\(o\\|hen\\)\\)\\>"
 430            font-lock-constant-face)
 431
 432      ;; SAS dataset options/PROC statements followed by an equal sign/left parentheses
 433
 434      (cons (concat
 435             "[ \t(,]"
 436             "\\(attrib\\|by\\|compress\\|d\\(ata\\|rop\\)\\|f\\(irstobs\\|ormat\\)"
 437             "\\|i\\(d\\|f\\|n\\)\\|ke\\(ep\\|y\\)\\|l\\(abel\\|ength\\)"
 438             "\\|o\\(bs\\|rder\\|ut\\)\\|rename\\|s\\(ortedby\\|plit\\)"
 439             "\\|var\\|where\\)"
 440             "[ \t]*=")
 441            font-lock-keyword-face)
 442      (cons "\\<\\(in\\(:\\|dex[ \t]*=\\)?\\|until\\|wh\\(en\\|ile\\)\\)[ \t]*("
 443            font-lock-keyword-face)
 444
 445      ;; SAS statements
 446      (cons (concat
 447             "\\(^[0-9]*\\|):\\|[;,]\\|then\\|else\\)[ \t]*"
 448             "\\(a\\(bort\\|rray\\|ttrib\\)\\|by"
 449             "\\|c\\(hange\\|lass\\|ontrast\\)"
 450             "\\|d\\(elete\\|isplay\\|m\\|o\\([ \t]+\\(data\\|over\\)\\)?\\|rop\\)"
 451             "\\|e\\(rror\\|stimate\\|xc\\(hange\\|lude\\)\\)"
 452             "\\|f\\(ile\\(name\\)?\\|o\\(otnote\\(10?\\|[2-9]\\)?\\|rmat\\)\\|req\\)"
 453             "\\|go\\([ \t]*to\\|ptions\\)"
 454             "\\|[hv]bar\\(3d\\)?"
 455             "\\|i\\(d\\|f\\|n\\(dex\\|f\\(ile\\|ormat\\)\\|put\\|value\\)\\)"
 456             "\\|keep\\|l\\(abel\\|ength\\|i\\(bname\\|nk\\|st\\)\\|smeans\\)"
 457             "\\|m\\(anova\\|e\\(ans\\|rge\\)\\|issing\\|od\\(el\\|ify\\)\\)\\|note"
 458             "\\|o\\(ptions\\|therwise\\|utput\\)\\|p\\(arms\\|lot2?\\|ut\\)"
 459             "\\|r\\(andom\\|e\\(name\\|peated\\|tain\\)\\)"
 460             "\\|s\\(ave\\|e\\(lect\\|t\\)\\|kip\\|trata\\|umby\\)"
 461             "\\|t\\(ables?\\|i\\(me\\|tle\\(10?\\|[2-9]\\)?\\)\\)\\|update"
 462             "\\|va\\(lue\\|r\\)\\|w\\(eight\\|here\\|i\\(ndow\\|th\\)\\)"
 463
 464             ;; IML statements that are not also SAS statements
 465             "\\|append\\|c\\(lose\\(file\\)?\\|reate\\)\\|edit\\|f\\(ind\\|orce\\|ree\\)"
 466             "\\|insert\\|load\\|mattrib\\|p\\(a[ru]se\\|rint\\|urge\\)"
 467             "\\|re\\(move\\|peat\\|place\\|set\\|sume\\)"
 468             "\\|s\\(et\\(in\\|out\\)\\|how\\|ort\\|tore\\|ummary\\)\\|use\\)?"
 469
 470             "\\>")                                  font-lock-keyword-face)
 471
 472
 473
 474      ;;  (cons "\\<\\(\\(then\\|else\\)[ \t]*\\)?\\(do\\([ \t]*over\\)?\\|else\\)\\>"
 475      ;;                                             font-lock-keyword-face)
 476
 477      ;; SAS statements that must be followed by a semi-colon
 478      (cons (concat
 479             "\\(^[0-9]*\\|):\\|[;,]\\|then\\|else\\)[ \t]*"
 480             "\\(cards4?\\|datalines\\|end\\|l\\(ostcard\\)\\|page\\|return\\|stop\\)?"
 481             "[ \t]*;")                      font-lock-keyword-face)
 482
 483      ;; SAS/GRAPH statements not handled above
 484      (cons (concat
 485             "\\(^[0-9]*\\|):\\|[;,]\\)[ \t]*"
 486             "\\(axis\\|legend\\|pattern\\|symbol\\)"
 487             "\\([1-9][0-9]?\\)?\\>")        font-lock-keyword-face)
 488
 489      ;; SAS Datastep functions and SAS macro functions
 490                                         ;(cons "%[a-z_][a-z_0-9]*[ \t]*[(;]"
 491      ;; SAS macro functions occasionally defined with no arguments
 492      ;; which means they can be followed by any character that can
 493      ;; separate tokens, however, they are most likely to be followed
 494      ;; by operat-ions/ors
 495      (cons "%[a-z_][a-z_0-9]*[- \t();,+*/=<>]"
 496            font-lock-function-name-face)
 497      (cons "\\<call[ \t]+[a-z_][a-z_0-9]*[ \t]*("
 498            font-lock-function-name-face)
 499
 500      (cons (concat
 501             "\\<"
 502             "\\(a\\(bs\\|r\\(cos\\|sin\\)\\|tan\\)\\|b\\(etainv\\|yte\\)"
 503             "\\|c\\(eil\\|inv\\|o\\(llate\\|mpress\\|sh?\\)\\|ss\\|v\\)"
 504             "\\|dacc\\(db\\(\\|sl\\)\\|s\\(l\\|yd\\)\\|tab\\)"
 505             "\\|dep\\(db\\(\\|sl\\)\\|s\\(l\\|yd\\)\\|tab\\)"
 506             "\\|d\\(a\\(te\\(\\|jul\\|part\\|time\\)\\|y\\)\\|hms\\|i\\(f[0-9]*\\|m\\|gamma\\)\\)"
 507             "\\|e\\(rfc?\\|xp\\)"
 508             "\\|f\\(i\\(nv\\|p\\(namel?\\|state\\)\\)\\|loor\\|uzz\\)\\|gam\\(inv\\|ma\\)"
 509             "\\|h\\(bound\\|ms\\|our\\)\\|i\\(n\\(dexc?\\|put\\|t\\(\\|ck\\|nx\\|rr\\)\\)\\|rr\\)"
 510             "\\|juldate\\|kurtosis\\|l\\(ag[0-9]*\\|bound\\|e\\(ft\\|ngth\\)\\|gamma\\|og\\(\\|10\\|2\\)\\)"
 511             "\\|m\\(ax\\|dy\\|ean\\|in\\(\\|ute\\)\\|o\\(d\\|nth\\|rt\\)\\)"
 512             "\\|n\\(\\|etpv\\|miss\\|o\\(rmal\\|t\\)\\|pv\\)"
 513             "\\|prob\\([ft]\\|b\\(eta\\|nml\\)\\|chi\\|gam\\|hypr\\|it\\|n\\(egb\\|orm\\)\\)"
 514             "\\|ordinal\\|p\\(oisson\\|ut\\)\\|qtr\\|r\\(e\\(peat\\|verse\\)\\|ight\\|ound\\)"
 515             "\\|ran\\(bin\\|cau\\|exp\\|g\\(am\\|e\\)\\|k\\|nor\\|poi\\|t\\(bl\\|ri\\)\\|uni\\)"
 516             "\\|s\\(aving\\|can\\|econd\\|i\\(gn\\|nh?\\)\\|qrt\\|t\\(d\\(\\|err\\)\\|fips\\|namel?\\)\\|u\\(bstr\\|m\\)\\|ymget\\)"
 517             "\\|t\\(anh?\\|i\\(me\\(\\|part\\)\\|nv\\)\\|oday\\|r\\(anslate\\|i\\(gamma\\|m\\)\\|unc\\)\\)"
 518             "\\|u\\(niform\\|pcase\\|ss\\)\\|v\\(ar\\|erify\\)"
 519             "\\|weekday\\|y\\(ear\\|yq\\)\\|zip\\(fips\\|namel?\\|state\\)"
 520
 521 ;;;    ;; SAS functions introduced in Technical Report P-222
 522
 523             "\\|airy\\|b\\(and\\|lshift\\|not\\|or\\|rshift\\|xor\\)"
 524             "\\|c\\(nonct\\|ompbl\\)\\|d\\(airy\\|equote\\)\\|fnonct\\|tnonct"
 525             "\\|i\\(bessel\\|n\\(dexw\\|put[cn]\\)\\)\\|jbessel\\|put[cn]"
 526             "\\|lowcase\\|quote\\|resolve\\|s\\(oundex\\|ysprod\\)\\|tr\\(anwrd\\|imn\\)"
 527
 528 ;;;    ;; IML functions that are not also Datastep functions
 529             "\\|a\\(ll\\|ny\\|pply\\|rmasim\\)\\|b\\(lock\\|ranks\\|tran\\)"
 530             "\\|c\\(har\\|hoose\\|on\\(cat\\|tents\\|vexit\\|vmod\\)\\|ovlag\\|shape\\|usum\\|vexhull\\)"
 531             "\\|d\\(atasets\\|esignf?\\|et\\|iag\\|o\\|uration\\)"
 532             "\\|e\\(chelon\\|igv\\(al\\|ec\\)\\)\\|f\\(ft\\|orward\\)\\|ginv"
 533             "\\|h\\(alf\\|ankel\\|dir\\|ermite\\|omogen\\)"
 534             "\\|i\\(\\|fft\\|nsert\\|nv\\(updt\\)?\\)\\|j\\(\\|root\\)\\|loc\\|mad"
 535             "\\|n\\(ame\\|col\\|leng\\|row\\|um\\)\\|o\\(pscal\\|rpol\\)"
 536             "\\|p\\(olyroot\\|roduct\\|v\\)\\|r\\(anktie\\|ates\\|atio\\|emove\\|eturn\\|oot\\|owcatc?\\)"
 537             "\\|s\\(etdif\\|hape\\|olve\\|plinev\\|pot\\|qrsym\\|ssq\\|torage\\|weep\\|ymsqr\\)"
 538             "\\|t\\(\\|eigv\\(al\\|ec\\)\\|oeplitz\\|race\\|risolv\\|ype\\)"
 539             "\\|uni\\(on\\|que\\)\\|v\\(alue\\|ecdiag\\)\\|x\\(mult\\|sect\\)\\|yield"
 540
 541 ;;;    ;; SCL functions that are known to work with SAS macro function %sysfunc
 542
 543             "\\|attr[cn]\\|c\\(exist\\|lose\\)\\|d\\(close\\|num\\|open\\|read\\)"
 544             "\\|exist\\|f\\(close\\|etchobs\\|i\\(leexist\\|nfo\\)\\|open\\|put\\|write\\)"
 545             "\\|get\\(option\\|var[cn]\\)\\|lib\\(name\\|ref\\)\\|op\\(en\\|t\\(getn\\|setn\\)\\)"
 546             "\\|pathname\\|sysmsg\\|var\\(fmt\\|l\\(abel\\|en\\)\\|n\\(ame\\|um\\)\\|type\\)\\)"
 547             "[ \t]*(")                      font-lock-function-name-face)
 548      ))
 549   "Font Lock regexs for SAS.")
 550
 551
 552 (defvar SAS-editing-alist
 553   '((sentence-end                 . ";[\t\n */]*")
 554     (paragraph-start              . "^[ \t]*$")
 555     (paragraph-separate           . "^[ \t]*$")
 556     (paragraph-ignore-fill-prefix . t)
 557     ;;(fill-paragraph-function      . 'lisp-fill-paragraph)
 558     (adaptive-fill-mode           . nil)
 559     (indent-line-function         . 'sas-indent-line)
 560     ;;(indent-region-function       . 'sas-indent-region)
 561     (require-final-newline        . t)
 562     (comment-start                . "** ")
 563     (comment-start-skip           . "[*][*] ")
 564     (comment-end                  . " **;")
 565     (comment-end-skip             . " [*][*];")
 566     (comment-column               . 40)
 567     ;;(comment-indent-function      . 'lisp-comment-indent)
 568     (parse-sexp-ignore-comments   . t)
 569     (ess-set-style                . ess-default-style)
 570     (ess-local-process-name       . nil)
 571     ;;(ess-keep-dump-files          . 'ask)
 572     (tab-stop-list                . ess-sas-tab-stop-list)
 573     (ess-mode-syntax-table        . SAS-syntax-table)
 574     (font-lock-keywords-case-fold-search . t)
 575     (font-lock-defaults           . '(SAS-mode-font-lock-keywords)))
 576   "General options for editing SAS source files.")
 577
 578 (defun beginning-of-sas-statement (arg &optional comment-start)
 579   "Move point to beginning of current sas statement."
 580   (interactive "P")
 581   (let ((pos (point))
 582         )
 583     (if (search-forward ";" nil 1) (forward-char -1))
 584     (re-search-backward ";[ \n*/]*$" (point-min) 1 arg)
 585     (skip-chars-forward sas-comment-chars)
 586     (if comment-start nil
 587           (if (looking-at "\\*/")
 588               (progn (forward-char 2)
 589                      (skip-chars-forward sas-comment-chars)))
 590           (while (looking-at "/\\*")
 591             (if (not (search-forward "*/" pos t 1)) ;;(;; (point-max) 1 1)
 592                 (forward-char 2))
 593             (skip-chars-forward sas-white-chars)))))
 594
 595 (defun sas-indent-line ()
 596   "Indent function for SAS mode."
 597   (interactive)
 598   (let (indent prev-end
 599                (pos (- (point-max) (point)))
 600                (case-fold-search t)
 601                (cur-ind (current-indentation))
 602                (comment-col (sas-comment-start-col))) ;; 2/1/95 TDC
 603     (save-excursion
 604       (cond ((progn
 605                (back-to-indentation)
 606                (or (bobp)
 607                    (looking-at
 608                     "data[ ;]\\|proc[ ;]\\|run[ ;]\\|endsas[ ;]\\|g?options[ ;]\\|%macro[ ;]\\|%mend[ ;]")))
 609              ;;  Case where current statement is DATA, PROC, etc...
 610              (setq prev-end (point))
 611              (goto-char (point-min))
 612              ;;  Added 6/27/94
 613              ;;  May get fooled if %MACRO, %DO, etc embedded in comments
 614              (setq indent
 615                    (+ (* (- (sas-how-many "^[ \t]*%macro\\|[ \t]+%do"
 616                                           prev-end)
 617                             (sas-how-many "^[ \t]*%mend\\|%end" prev-end))
 618                          sas-indent-width) comment-col)))  ;; 2/1/95 TDC
 619             ;;  Case where current line begins with sas-indent-ignore-comment
 620             ;; added 6/27/94  to leave "* ;" comments alone.
 621             ((progn
 622                (back-to-indentation)
 623                (and (not (looking-at "*/"))
 624                     (looking-at (concat sas-indent-ignore-comment "\\|/\\*"))))
 625              (setq indent (current-indentation)))
 626             ;;  Case where current statement not DATA, PROC etc...
 627             (t (beginning-of-line 1)
 628                (skip-chars-backward sas-white-chars)
 629                (if (bobp) nil
 630                  (backward-char 1))
 631                (cond
 632                 ((looking-at ";")       ;  modified 1/31/95
 633                  (setq indent (sas-next-statement-indentation)))
 634                 ((save-excursion;; added 4/28/94 to properly check
 635                    (if (bobp) () (backward-char 1));; for end of comment
 636                    (setq prev-end (point))
 637                    (looking-at "*/"));;  improved 1/31/95
 638                  (save-excursion
 639                    (search-backward "*/"
 640                                     (point-min) 1 1); comment start is first /*
 641                    (search-forward "/*"
 642                                    prev-end 1 1)    ; after previous */
 643                    (backward-char 2)                ; 2/1/95 TDC
 644                    (skip-chars-backward sas-white-chars)
 645                    (setq indent
 646                          (if (bobp) 0
 647                            (if (looking-at ";")
 648                                (sas-next-statement-indentation)
 649                              (+ (current-indentation) sas-indent-width))))))
 650
 651                 ;; added 6/27/94 to leave "* ;" comments alone
 652                 ((save-excursion
 653                    (progn
 654                      (beginning-of-sas-statement 1 t)
 655                      (and (not (looking-at "*/"))
 656                           (looking-at sas-indent-ignore-comment))))
 657                  (setq indent cur-ind))
 658                 ((progn
 659                    (beginning-of-sas-statement 1)
 660                    (bobp));; added 4/13/94
 661                  (setq indent sas-indent-width));; so the first line works
 662                 (t
 663                  (if (progn
 664                        (save-excursion
 665                          (beginning-of-line 1)
 666                          (skip-chars-backward sas-white-chars)
 667                          (if (bobp) nil (backward-char 1))
 668                          (or (looking-at ";")
 669                              (bobp) (backward-char 1) (looking-at "\\*/"))))
 670                      (setq indent (+ (current-indentation) sas-indent-width))
 671                    (setq indent (current-indentation))))))))
 672     (save-excursion
 673       (let (beg end)
 674         (back-to-indentation)
 675         (setq end (point))
 676         (beginning-of-line 1)
 677         (setq beg (point))
 678         (delete-region beg end)
 679         (indent-to indent)))
 680     (if (> (- (point-max) pos) (point))
 681         (goto-char (- (point-max) pos)))))
 682
 683
 684 ;;(defun sas-indent-region (start end)
 685 ;;  "Indent a region of SAS code."
 686 ;;  (interactive "r")
 687 ;;  (save-excursion
 688 ;;    (let ((endmark (copy-marker end)))
 689 ;;      (goto-char start)
 690 ;;      (and (bolp) (not (eolp))
 691 ;;         (sas-indent-line))
 692 ;;      (indent-sexp endmark)
 693 ;;      (set-marker endmark nil))))
 694
 695
 696 (defun indent-sas-statement (arg)
 697   "Indent all continuation lines sas-indent-width spaces from first
 698 line of statement."
 699   (interactive "p")
 700   (let (end)
 701     (save-excursion
 702       (if (> arg 0)
 703           (while (and (> arg 0) (search-forward ";" (point-max) 1 1))
 704             (setq end (point))
 705             (if (bobp) nil (backward-char 1))
 706             (beginning-of-sas-statement 1)
 707             (forward-char 1)
 708             (indent-region (point)
 709                            end
 710                            (+ (current-column) (1- sas-indent-width)))
 711             (search-forward ";" (point-max) 1 1)
 712             (setq arg (1- arg)))))))
 713
 714 ;; added 9/31/94
 715 (defun sas-next-statement-indentation ()
 716   "Returns the correct indentation of the next sas statement.
 717 The current version assumes that point is at the end of the statement.
 718 This will (hopefully) be fixed in later versions."
 719   (if (bobp) 0
 720     (save-excursion
 721       (let ((prev-end (point)))
 722         (beginning-of-sas-statement 1)
 723         (while (and (not (bobp))
 724                     (not (looking-at "*/"))
 725                     (looking-at sas-indent-ignore-comment))
 726           (skip-chars-backward sas-white-chars)
 727           (if (bobp) nil
 728             (backward-char 1))
 729           (setq prev-end (point))
 730           (beginning-of-sas-statement 1 t))
 731         (if (or
 732              (looking-at
 733               "data[ \n\t;]\\|proc[ \n\t]\\|%?do[ \n\t;]\\|%macro[ \n\t]\\|/\\*")
 734              (save-excursion
 735                (re-search-forward
 736                 "\\b%?then\\>[ \n\t]*\\b%?do\\>\\|\\b%?else\\>[ \n\t]*\\b%?do\\>"
 737                 prev-end 1 1))) ; fixed 1/30/95 to avoid being fooled by
 738                                 ; variable names starting with "do"
 739             (+ (current-indentation) sas-indent-width)
 740           (if (looking-at "%?end[ ;\n]\\|%mend[ ;\n]\\|\\*/")
 741               (max (- (current-indentation) sas-indent-width) 0)
 742             (current-indentation)))))))
 743
 744 ;; added 2/1/95
 745 (defun sas-comment-start-col ()
 746   "If the current line is inside a /* */ comment, returns column in which the
 747 opening /* appears.  returns 0 otherwise."
 748   (let ((pos (point)))
 749     (save-excursion
 750       (if (and (search-backward "*/" (point-min) 1 1)
 751                (search-forward "/*" pos 1 1))
 752           (current-indentation)
 753         0))))
 754
 755
 756 ;;  Created 6/27/94 to verify that RUN; statements match PROC and DATA
 757 ;;  statements.  Useful since indentation my be goofy w/o "RUN;"
 758 (defun sas-check-run-statements ()
 759   "Check to see that \"run\" statements are matched with proc, data statements."
 760   (interactive)
 761   (let (pos
 762         (ok t)
 763         (eob-ok t))
 764     (save-excursion
 765       (beginning-of-line)
 766       (while ok
 767         (if (re-search-forward
 768              "\\(^[ \t]*run[ ;]\\)\\|\\(^[ \t]*proc \\|^[ \t]*data[ ;]\\)"
 769              nil 1)
 770             (if (match-beginning 2)
 771                 (if (re-search-forward
 772                      "\\(^[ \t]*run[ ;]\\)\\|\\(^[ \t]*proc \\|^[ \t]*data[ ;]\\)"
 773                      nil t)
 774                     (progn (setq pos (point))
 775                            (setq ok (match-beginning 1)))
 776                   (setq eob-ok nil pos (point-max))))
 777           (setq ok nil)))
 778       (setq ok (eobp)))
 779     (if (and ok eob-ok) (message "Run statements match")
 780       (goto-char pos)
 781       (beep)
 782       (message "Missing Run Statement."))))
 783
 784
 785 (defun sas-fix-life-tables (start end)
 786   "Remove censored and duplicate observations from life tables generated by
 787 Proc Lifetest.  Operates on current region.  A major space saver if there is
 788 heavy censoring."
 789   (interactive "r")
 790   (save-excursion
 791     (shell-command-on-region
 792      start end
 793      "sed \"\\?          *\\.          *\\.          *\\.    ?d\"" t)))
 794 ;;(vip-goto-line 1)
 795 ;;(setq ex-g-flag nil
 796 ;;ex-g-variant nil)
 797 ;;(vip-ex "1,$g/           \\.           \\.           \\.    /d")))
 798
 799 (defun sas-fix-page-numbers (offset &optional page-num)
 800   "Fix number of current page in sas output files after editing.  Add
 801 OFFSET to actual page number."
 802   (interactive "P")
 803   (if (not offset) (setq offset 0))
 804   (if (not page-num) (setq page-num (sas-page-number)))
 805   (save-excursion
 806     (if (/= (preceding-char) ?\C-l) (backward-page 1))
 807     (let (end len mstart mend)
 808       (save-excursion
 809         (forward-line sas-page-number-max-line)
 810         (setq end (point)))
 811       (if (re-search-forward
 812            "\\(^[0-9]+[ ]\\)\\|\\([ ][0-9]+$\\)"
 813            end t)
 814           (progn (setq len (- (match-end 0) (match-beginning 0))
 815                        mstart (match-beginning 0)
 816                        mend (match-end 0))
 817                  (delete-region mstart mend)
 818                  (if (eolp)
 819                  (insert (format
 820                           (concat "%" len "d") (+ page-num offset)))
 821                  (insert (substring
 822                           (concat (+ (sas-page-number) offset) "      ")
 823                           0 len))))))))
 824
 825 (defun sas-page-fix (start)
 826   "Fix page numbers in sas output from point to end of file.
 827 If START is given this will be the number for the current page."
 828   (interactive "P")
 829   (let (offset (pnum (sas-page-number)))
 830   (if (not start) (setq offset 0)
 831     (setq offset (- start pnum)))
 832   (while (not (eobp))
 833     (sas-fix-page-numbers offset pnum)
 834     (setq pnum (1+ pnum))
 835     (forward-page 1))))
 836
 837 (defun fix-page-breaks ()
 838   "Fix page breaks in SAS 6 print files."
 839   (interactive)
 840   (save-excursion
 841     (goto-char (point-min))
 842     (if (looking-at "\f") (delete-char 1))
 843     (replace-regexp "^\\(.+\\)\f" "\\1\n\f\n")
 844     (goto-char (point-min))
 845     (replace-regexp "^\f\\(.+\\)" "\f\n\\1")
 846     (goto-char (point-min))
 847     (replace-regexp "
 848 $" "")
 849     (goto-char (point-min))
 850     (replace-regexp "
 851 \\([^
 852 \\$]+\\)" "\n\\1")
 853     (goto-char (point-max))
 854     (if (not (bobp))
 855         (progn (backward-char 1)
 856                (if (not (looking-at "\n"))
 857                    (progn (forward-char 1) (open-line 1)))))))
 858
 859 (defun sas-page-number ()
 860   ;; like what-page except it returns an integer page number
 861   "Return page number of point in current buffer."
 862   (let ((opoint (point))) (save-excursion
 863        (goto-char (point-min))
 864        (1+ (sas-how-many page-delimiter opoint)))))
 865
 866 (defun sas-how-many (regexp &optional end)
 867   ;; a copy of `how-many' which returns an integer
 868   ;; rather than a message
 869   "Return number of matches for REGEXP following point."
 870   (let ((count 0) opoint)
 871     (save-excursion
 872      (while (and (not (eobp))
 873                  (progn (setq opoint (point))
 874                         (re-search-forward regexp end t)))
 875        (if (= opoint (point))
 876            (forward-char 1)
 877          (setq count (1+ count))))
 878      count)))
 879
 880 (defun beginning-of-sas-proc ()
 881   "Move point to beginning of sas proc, macro or data step."
 882   (interactive)
 883   (let ((case-fold-search t))
 884     (forward-char -1)
 885     (while (not (or (looking-at "data\\|proc\\|%macro")
 886                     (bobp)))
 887       (re-search-backward "proc\\|data\\|%macro" (point-min) 1)
 888       (beginning-of-sas-statement 1))))
 889
 890 (defun next-sas-proc (arg)
 891   "Move point to beginning of next sas proc."
 892   (interactive "P")
 893   (let ((case-fold-search t))
 894     (forward-char 1)
 895     (if (re-search-forward
 896          "^[ \t]*\\(data[ ;]\\|proc[ ;]\\|endsas[ ;]\\|g?options[ ;]\\|%macro[ ;]\\)"
 897          nil t arg)
 898         (beginning-of-sas-statement 1)
 899       (forward-char -1))))
 900
 901 (defun set-sas-file-name ()
 902   "Stores the name of the current sas file."
 903   (let ((name (buffer-file-name)))
 904     (cond ((not name))
 905           ((string-match (substring name -4 nil)
 906                          "\\.sas\\|\\.lst\\|\\.log")
 907
 908            (setq sas-file-name (substring name 0 (- (length name) 4)))
 909            (setq sas-buffer-name (buffer-name))
 910            (setq sas-file-root (substring sas-buffer-name 0
 911                                           (- (length sas-buffer-name) 4))))
 912           (t (message "This file does not have a standard suffix")))))
 913
 914 ;;  created 6/27/94
 915 (defun sas-set-alternate-file-name (name)
 916   "Stores the NAME of an alternate sas file.
 917 When this file is submitted with `submit-sas', the alternate file will
 918 be submitted instead.  `sas-submitable' is automatically sets to t."
 919     (interactive "f")
 920     (cond ((string-match (substring name -4 nil)
 921                          "\\.sas\\|\\.lst\\|\\.log")
 922            (setq sas-file-name (substring name 0 (- (length name) 4)))
 923            (setq sas-submitable t))
 924           (t (message "This file does not have a standard suffix"))))
 925
 926 (defun switch-to-sas-source ()
 927   "Switches to sas source file associated with the current file."
 928   (interactive)
 929   (switch-to-sas-file "sas"))
 930
 931 (defun switch-to-sas-lst ()
 932   "Switches to sas source file associated with the current file."
 933   (interactive)
 934   (switch-to-sas-file "lst"))
 935
 936 (defun switch-to-sas-log ()
 937   "Switches to sas source file associated with the current file."
 938   (interactive)
 939   (switch-to-sas-file "log"))
 940
 941 (defun switch-to-sas-source-other-window ()
 942   "Switches to sas source file associated with the current file."
 943   (interactive)
 944   (switch-to-sas-file-other-window "sas"))
 945
 946 (defun switch-to-sas-lst-other-window ()
 947   "Switches to sas source file associated with the current file."
 948   (interactive)
 949   (switch-to-sas-file-other-window "lst"))
 950
 951 (defun switch-to-sas-log-other-window ()
 952   "Switches to sas source file associated with the current file."
 953   (interactive)
 954   (switch-to-sas-file-other-window "log"))
 955
 956 ;;(defun switch-to-sas-file (suff &optional revert silent)
 957 ;;  "Switches to sas \"SUFF\" file associated with the current file"
 958 ;;  (let* ((sfile sas-file-name)
 959 ;;       (buf (get-file-buffer (concat sfile "." suff)))
 960 ;;       (sas-require-confirmation
 961 ;;           (and sas-require-confirmation (not revert))))
 962 ;;     (if (or sas-require-confirmation (string-equal suff "sas") (not buf))
 963 ;;         (find-file (concat sfile "." suff))
 964 ;;       (progn (switch-to-buffer buf)
 965 ;;              (if (not (verify-visited-file-modtime (current-buffer)))
 966 ;;                  (progn (revert-buffer t t)
 967 ;;                         (if (not silent)
 968 ;;                             (message "File has changed on disk.  Buffer automatically updated."))))))
 969 ;;     (setq sas-file-name sfile))
 970 ;;   (if (string-equal suff "sas")
 971 ;;       (if (not (string-equal major-mode "sas-mode"))
 972 ;;           (sas-mode))
 973 ;;     (if (not (string-equal major-mode "sasl-mode"))
 974 ;;         (sasl-mode))))
 975 ;;
 976 ;;(defun switch-to-sas-file-other-window (suff)
 977 ;;  "Switches to sas \"SUFF\" file associated with the current file"
 978 ;;  (let* ((sfile sas-file-name)
 979 ;;       (buf (get-file-buffer (concat sfile "." suff))))
 980 ;;    (if (or sas-require-confirmation (string-equal suff "sas") (not buf))
 981 ;;      (find-file-other-window (concat sfile "." suff))
 982 ;;      (progn (switch-to-buffer-other-window buf)
 983 ;;           (if (not (verify-visited-file-modtime (current-buffer)))
 984 ;;               (progn (revert-buffer t t)
 985 ;;                      (message "File has changed on disk.  Buffer automatically updated.")))))
 986 ;;    (setq sas-file-name sfile))
 987 ;;  (if (string-equal suff "sas")
 988 ;;      (if (not (string-equal major-mode "sas-mode"))
 989 ;;        ;;(sas-mode)
 990 ;;        )
 991 ;;    (if (not (string-equal major-mode "sasl-mode"))
 992 ;;      ;;(sasl-mode)
 993 ;;      )))
 994
 995 (defun switch-to-sas-file (suff)
 996   "Switches to sas \"SUFF\" file associated with the current file."
 997   (switch-to-buffer (set-sas-file-buffer suff)))
 998
 999 (defun switch-to-sas-file-other-window (suff)
1000   "Switches to sas \"SUFF\" file associated with the current file."
1001   (switch-to-buffer-other-window (set-sas-file-buffer suff)))
1002
1003 ;;  The following was created 6/7/94 to handle buffers without messing up
1004 ;;  windows.
1005
1006 (defun set-sas-file-buffer (suff &optional revert silent)
1007   "Sets current buffer to sas \"SUFF\" file associated with the current file."
1008   (let* ((sfile sas-file-name)
1009          (buf (get-file-buffer (concat sfile "." suff)))
1010          (sas-require-confirmation
1011           (and sas-require-confirmation (not revert))))
1012     (if (or sas-require-confirmation (string-equal suff "sas") (not buf))
1013         (set-buffer (find-file-noselect (concat sfile "." suff)))
1014       (progn (set-buffer buf)
1015              (if (not (verify-visited-file-modtime (current-buffer)))
1016                  (progn (revert-buffer t t)
1017                         (if (not silent)
1018                             (message "File has changed on disk.  Buffer automatically updated."))))))
1019     (setq sas-file-name sfile))
1020   ;;(if (string-equal suff "sas")
1021   ;; (if (not (string-equal major-mode "sas-mode")) (sas-mode))
1022   ;; (if (not (string-equal major-mode "sasl-mode"))(sasl-mode))
1023   (current-buffer))
1024
1025 (defun switch-to-sas-process-buffer ()
1026   "Switch to sas-process-buffer."
1027   (interactive)
1028   (let (buf proc-name)
1029     (setq proc-name (concat "SAS" sas-file-name)
1030           buf (concat "*" proc-name "*"))
1031     (switch-to-buffer-other-window buf)))
1032
1033 (defun submit-sas ()
1034   ;; 6/17/94  added sas-submitable local variable.
1035   "Submit SAS file as shell command."
1036   (interactive)
1037   (if ;; can file be run, or is it only for inclusion?
1038       (or sas-submitable
1039           (progn
1040             (beep)
1041             (y-or-n-p
1042              (format
1043               "Submission is disabled for this file.  Submit it anyway? "))))
1044       (progn
1045         ;; if buffer name has changed, tell user
1046         (if (or
1047              (string-equal sas-buffer-name (buffer-name))
1048              (not
1049               (y-or-n-p
1050                (format
1051                 "The name of this buffer has changed.  Submit the new file? "))))
1052             (setq sas-buffer-name (buffer-name))
1053           (set-sas-file-name))
1054         (let ((sas-file sas-file-name)
1055               (sas-root sas-file-root)
1056               ;;(sas-buf  sas-buffer-name)
1057               proc-name
1058               buf)
1059
1060           ;; Save buffer to SAS the right file :-).
1061           (if (buffer-modified-p)
1062               (if (y-or-n-p (format "Buffer %s is modified. Save it? "
1063                                     (buffer-name)))
1064                   (save-buffer)))
1065           (setq proc-name (concat "SAS" sas-file)
1066                 buf (concat "*" proc-name "*"))
1067           (if (get-buffer buf)
1068               (save-window-excursion (switch-to-buffer buf)
1069                                      (erase-buffer)
1070                                      (setq default-directory
1071                                            (file-name-directory sas-file))))
1072
1073           (run-hooks 'sas-pre-run-hook)  ;; added 8/24/94
1074           (message "----  Submitting SAS job   ----")
1075           ;; (switch-to-buffer buf)
1076           (make-comint proc-name
1077                        sas-program     ;added sas-program 4/29/94
1078                        nil
1079                        sas-root)
1080           (save-window-excursion
1081             (switch-to-buffer buf)
1082             (setq sas-file-name sas-file)
1083             (bury-buffer buf))
1084
1085           (message "----  SAS job submitted  ----   ")
1086
1087           (if sas-notify;;  added 4/7/94
1088               (set-process-sentinel (get-process proc-name) 'sas-sentinel)
1089             (display-buffer buf t))))
1090     (message "----  File not submitted  ----")))
1091
1092 ;; 5/2/94 Modified sas-sentinel to check for errors in log file upon
1093 ;; completion.
1094 (defun sas-sentinel (proc arg);; created 4/7/94
1095   "Notify user that SAS run is done."
1096   (beep)
1097   ;;(if (string-equal arg "finished\n")
1098   (save-excursion
1099     (let (msg buf win (sbuf (concat "*" (process-name proc) "*")))
1100       (setq msg
1101             (format "SAS %s %s"
1102                     (substring arg 0 -1)
1103                     (if sas-error-notify
1104                         ;;(save-window-excursion
1105                         (progn
1106                           (set-buffer sbuf)
1107                           (setq buf (set-sas-file-buffer "log" t t))
1108                           (goto-char (point-min))
1109                           (setq win (get-buffer-window buf))
1110                           (save-window-excursion
1111                             (if win
1112                                 (progn
1113                                   (select-window win)
1114                                   (if (re-search-forward "^ERROR" nil t)
1115                                       " (See .log file for errors)"
1116                                     ""))
1117                               (switch-to-buffer buf)
1118                               (if (re-search-forward "^ERROR" nil t)
1119                                   " (See .log file for errors)"
1120                                 ""))))
1121                       "")))
1122       (set-buffer sbuf)
1123       (goto-char (point-max))
1124       (insert msg)
1125       (bury-buffer (get-buffer sbuf))
1126       ;;(if (and sas-notify-popup window-system)
1127       ;;    (x-popup-dialog t
1128       ;;                (list "SAS Menu" (cons msg  nil) )))
1129       ;;(if (not (minibuffer-window-active-p)) (princ msg))
1130       (princ msg))))
1131
1132 ;; 5/2/94 Modified run-sas-on-region to separate log and output buffers.
1133 ;;
1134 ;;(defun run-sas-on-region (start end append &optional buffer)
1135 ;;  "Submit region to SAS"
1136 ;;  (interactive "r\nP")
1137 ;;  (message "----  Running SAS  ----")
1138 ;;  (let ((sfile sas-file-name)
1139 ;;        (shell-file-name "/bin/sh")
1140 ;;        serror buff)
1141 ;;    (setq buffer (or buffer "*SAS output*"))
1142 ;;    (save-excursion
1143 ;;      (shell-command-on-region
1144 ;;       start end;; added sas-program
1145 ;;       (concat sas-program " -nonews -stdio 2> /tmp/_temp_.log" nil))
1146 ;;      (get-buffer-create "*SAS Log*")
1147 ;;      (save-window-excursion
1148 ;;        (switch-to-buffer "*SAS Log*")
1149 ;;        (erase-buffer)
1150 ;;        (insert-file-contents "/tmp/_temp_.log")
1151 ;;        (delete-file "/tmp/_temp_.log")
1152 ;;        (setq serror (re-search-forward "^ERROR" nil t))
1153 ;;        (if serror () (bury-buffer)))
1154 ;;      (setq buff (get-buffer-create buffer))
1155 ;;      (save-window-excursion
1156 ;;        (switch-to-buffer buff)
1157 ;;        (setq sas-file-name sfile)
1158 ;;        (if append
1159 ;;            (progn
1160 ;;              (end-of-buffer)
1161 ;;              (insert "\f\n"))
1162 ;;          (erase-buffer))
1163 ;;        (if (get-buffer "*Shell Command Output*")
1164 ;;            (progn (insert-buffer "*Shell Command Output*")
1165 ;;                   (kill-buffer "*Shell Command Output*"))
1166 ;;          (insert "SAS completed with no output."))
1167 ;;        (if append () (sasl-mode))
1168 ;;        (message "----  SAS Complete ----")))
1169 ;;    (if (not serror)
1170 ;;        (switch-to-buffer-other-window  buff)
1171 ;;      (switch-to-buffer-other-window "*SAS Log*")
1172 ;;      (goto-char serror)
1173 ;;      (beep)
1174 ;;      (message "Error found in log file.")
1175 ;;      )))
1176
1177 (defun switch-to-dataset-log-buffer ()
1178   "Switch to log buffer for run-sas-on-region."
1179   (interactive)
1180   (switch-to-buffer-other-window "*SAS Log*"))
1181
1182 (defun switch-to-dataset-source-buffer ()
1183   "Switch to source buffer for run-sas-on-region."
1184   (interactive)
1185   (switch-to-buffer-other-window (format " *sas-tmp-%s*" sas-dataset)))
1186
1187 ;;(defun sas-get-dataset (filename &optional arg opts-p append buffer vars)
1188 ;;  "Run proc contents and proc print on SAS dataset.  Automatically prompts
1189 ;;for SAS options to use.  Default options are defined by the variable
1190 ;;`sas-get-options'.  Output may be updated from within output buffer with
1191 ;;C-cr if dataset changes.  Also, the source code which generates the output
1192 ;;may be edited with C-cs.  Typing C-cr within the output buffer reexecutes
1193 ;;the (modified) source code."
1194 ;;  (interactive "fName of SAS dataset (file name):")
1195 ;;  (let ((file (file-name-nondirectory filename))
1196 ;;        (dir (file-name-directory filename))
1197 ;;        (opts sas-get-options)
1198 ;;        (minibuffer-history sas-get-options-history)
1199 ;;        buf); fsize)
1200 ;;    (setq buffer (or buffer (concat "*" file "*")))
1201 ;;    (setq opts (if opts-p opts (read-string "SAS options: " opts)))
1202 ;;    (setq sas-get-options-history minibuffer-history)
1203 ;;    (cond ((string-match (substring file -6 nil) "\\.ssd01")
1204 ;;      (setq file (substring file 0 (- (length file) 6))))
1205 ;;    (t (error "This file is not a SAS dataset.")))
1206 ;;    (setq buf (format " *sas-tmp-%s*" file))
1207 ;;    (get-buffer-create buf)
1208 ;;    (save-window-excursion
1209 ;;      (switch-to-buffer buf)
1210 ;;      (erase-buffer)
1211 ;;      (setq default-directory dir)
1212 ;;      (if opts
1213 ;;          (insert (format "options  %s ;\n" opts)))
1214 ;;      (insert (format "title \"Contents of SAS dataset `%s'\" ;\n" file))
1215 ;;      (insert (format "libname %s '%s' ;\n" sas-tmp-libname dir))
1216 ;;      (if (not (equal arg 1))
1217 ;;               (insert (format "proc contents data = %s.%s ;\n" sas-tmp-libname file)))
1218 ;;      (if (equal arg 2) ()
1219 ;;        (insert (format "proc print data = %s.%s ;\n" sas-tmp-libname file))
1220 ;;        (if vars (insert (format "  var %s ;\n" vars))))
1221 ;;      (run-sas-on-region (point-min) (point-max) append
1222 ;;                         buffer)
1223 ;;      (get-buffer buffer)
1224 ;;      (if append () (sasd-mode))  ;; added 5/5/94
1225 ;;      (setq sas-dataset file))
1226 ;;    (if (get-buffer-window buffer t)
1227 ;;        (raise-frame (window-frame (get-buffer-window buffer t)))
1228 ;;    (display-buffer buffer (not append)))
1229 ;;    ))
1230
1231 ;;(defun revert-sas-dataset ()
1232 ;;  "Revert current sas dataset from disk version"
1233 ;;  (interactive)
1234 ;;  (let* ((file sas-dataset)
1235 ;;        (buf (format " *sas-tmp-%s*" file))
1236 ;;        (pos (point)))
1237 ;;      (save-window-excursion
1238 ;;        (switch-to-buffer buf)
1239 ;;        (run-sas-on-region (point-min) (point-max) nil
1240 ;;                           (concat "*" file ".ssd01*"))
1241 ;;        )
1242 ;;      (goto-char pos)  ;; added 6/9/94
1243 ;;    (sasd-mode)  ;; added 5/5/94
1244 ;;    (setq sas-dataset file)))
1245
1246 (defun sas-insert-local-variables ()  ;; created 6/17/94
1247   "Add local variables code to end of sas source file."
1248   (interactive)
1249   (save-excursion
1250     (if (re-search-forward "* *Local Variables: *;" nil t)
1251         ()
1252       (goto-char (point-max))
1253       (insert "
1254
1255 **  Local Variables:  ;
1256 **  End:  ;
1257 page ;
1258 "))))
1259
1260
1261
1262 ;;-*-emacs-lisp-*-
1263 ;;;  file name: sas-data.el
1264 ;;;
1265 ;;;  Version 1.0
1266 ;;;
1267 ;;;    sas-data-mode:  manage sas datasets
1268 ;;;    Copyright (C) 1994 Tom Cook
1269 ;;;
1270 ;;;    This program is free software; you can redistribute it and/or modify
1271 ;;;    it under the terms of the GNU General Public License as published by
1272 ;;;    the Free Software Foundation; either version 2 of the License, or
1273 ;;;    (at your option) any later version.
1274 ;;;
1275 ;;;    This program is distributed in the hope that it will be useful,
1276 ;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
1277 ;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1278 ;;;    GNU General Public License for more details.
1279 ;;;
1280 ;;;    You should have received a copy of the GNU General Public License
1281 ;;;    along with this program; if not, write to the Free Software
1282 ;;;    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
1283 ;;;
1284 ;;;  Author:   Tom Cook
1285 ;;;            Dept. of Biostatistics
1286 ;;;            University of Wisconsin - Madison
1287 ;;;            Madison, WI 53706
1288 ;;;            cook@biostat.wisc.edu
1289 ;;   Created: 8/11/94
1290 \f
1291 ;;  variables section
1292 (defvar sas-dir-mode-map nil)
1293 (defvar sas-directory-name nil
1294   "Name of directory associated with this buffer.")
1295 (make-variable-buffer-local 'sas-directory-name)
1296 (defvar sas-dir-buf-end nil)
1297 (make-variable-buffer-local 'sas-dir-buf-end)
1298 (defvar sas-sorted-by-num nil)
1299 (make-variable-buffer-local 'sas-sorted-by-num)
1300 ;; user variables
1301 \f
1302 ;; keymaps etc...
1303
1304 (if sas-dir-mode-map ()
1305    (setq sas-dir-mode-map (make-sparse-keymap))
1306    ;;(define-key sas-dir-mode-map "c" 'sas-contents)
1307    (define-key sas-dir-mode-map "p" 'sas-print)
1308    (define-key sas-dir-mode-map "m" 'sas-mark-item)
1309    (define-key sas-dir-mode-map "u" 'sas-unmark-item)
1310    (define-key sas-dir-mode-map " " 'sas-next-line)
1311    (define-key sas-dir-mode-map "\C-n" 'sas-next-line)
1312    (define-key sas-dir-mode-map "\C-p" 'sas-prev-line)
1313    (define-key sas-dir-mode-map "\177" 'sas-prev-line-undo)
1314    (define-key sas-dir-mode-map "\C-b" 'sas-backward-page-narrow)
1315    (define-key sas-dir-mode-map "\C-v" 'sas-forward-page-narrow)
1316    (define-key sas-dir-mode-map "\C-m" 'sas-goto-dataset)
1317    (define-key sas-dir-mode-map [mouse-2] 'sas-mouse-goto-dataset)
1318    (define-key sas-dir-mode-map "t" 'sas-dir-goto-page)
1319    (define-key sas-dir-mode-map "q" 'bury-buffer)
1320    (define-key sas-dir-mode-map "g" 'sas-revert-library)
1321    (define-key sas-dir-mode-map "1" 'digit-argument)
1322    (define-key sas-dir-mode-map "2" 'digit-argument)
1323    (define-key sas-dir-mode-map "3" 'digit-argument)
1324    (define-key sas-dir-mode-map "4" 'digit-argument)
1325    (define-key sas-dir-mode-map "5" 'digit-argument)
1326    (define-key sas-dir-mode-map "6" 'digit-argument)
1327    (define-key sas-dir-mode-map "7" 'digit-argument)
1328    (define-key sas-dir-mode-map "8" 'digit-argument)
1329    (define-key sas-dir-mode-map "9" 'digit-argument)
1330    (define-key sas-dir-mode-map [menu-bar sas run]
1331      '("Submit File " . submit-sas))
1332    )
1333
1334 ;(require 'sas)
1335
1336 (defun sas-dir-mode ()
1337   "Major mode for managing sas files."
1338   (interactive)
1339   (kill-all-local-variables)
1340   (use-local-map sas-dir-mode-map)
1341   (setq major-mode 'sas-dir-mode)
1342   (setq mode-name "SAS")
1343   (setq sas-directory-name (expand-file-name default-directory))
1344   (toggle-read-only 1))
1345
1346
1347 ;;(defun sas-make-library (directory &optional update)
1348 ;;  "Create a buffer with the names of all sas datasets from DIRECTORY."
1349 ;;  (interactive "DDirectory Name: ")
1350 ;;  (let ((dir (expand-file-name directory)) buf out cont pos)
1351 ;;    (setq buf (format " *sas-tmp-%s*" dir))
1352 ;;    (setq out (concat "*SAS-dir-" dir))
1353 ;;    (setq cont (concat "*SAS-cont-" dir))
1354 ;;    (get-buffer-create buf)
1355 ;;    (if (get-buffer out)
1356 ;;        (if update
1357 ;;            (progn
1358 ;;              (set-buffer out)
1359 ;;              (setq buffer-read-only nil)))
1360 ;;      (setq update t))
1361 ;;    (pop-to-buffer out)
1362 ;;    (setq default-directory dir)
1363 ;;    (setq pos (point))
1364 ;;    (if update
1365 ;;        (progn
1366 ;;          (save-window-excursion
1367 ;;            (set-buffer buf)
1368 ;;            (erase-buffer)
1369 ;;            (setq default-directory dir)
1370 ;;            (insert "options linesize=70 pagesize=1000 ;\n")
1371 ;;            (insert (format "title \"Contents of SAS directory `%s'\" ;\n"
1372 ;;                            dir))
1373 ;;            (insert (format "libname %s '%s' ;\n" sas-tmp-libname dir))
1374 ;;            (insert (format "proc contents data = %s._all_ directory details memtype=data ;\n" sas-tmp-libname))
1375 ;;            (run-sas-on-region (point-min) (point-max) nil
1376 ;;                               out)
1377 ;;            (set-buffer out)
1378 ;;            (goto-char (point-min))
1379 ;;            (if (= (sas-how-many page-delimiter (point-max)) 0)
1380 ;;                (let ((buffer-read-only nil))
1381 ;;                  (erase-buffer)
1382 ;;                  (insert "There are no SAS datasets in this directory")
1383 ;;                  (pop-to-buffer out))
1384 ;;              (save-excursion
1385 ;;                (set-buffer (get-buffer-create cont))
1386 ;;                (setq buffer-read-only t)
1387 ;;                (let ((buffer-read-only nil))
1388 ;;                  (erase-buffer)
1389 ;;                  (insert-buffer out)
1390 ;;                  (delete-region (point-min)
1391 ;;                                 (or (re-search-forward page-delimiter nil t)
1392 ;;                                     (point-min)))
1393 ;;                  (sas-page-fix 1)
1394 ;;                  (goto-char (point-min))
1395 ;;                  (sas-dir-mode)
1396 ;;                  (sas-narrow-to-page)))
1397 ;;              (if (re-search-forward page-delimiter nil t)
1398 ;;                  (delete-region (progn (beginning-of-line) (point))
1399 ;;                                 (point-max)))
1400 ;;              (sas-insert-set-properties (point-min) (point-max))
1401 ;;              )
1402 ;;            (switch-to-buffer out t)
1403 ;;            (goto-char (point-min))
1404 ;;            (sas-dir-mode)
1405 ;;            (setq sas-dir-buf-end (point-max)))
1406 ;;          (goto-char pos)
1407 ;;          (sas-move-to-filename (point-max))))))
1408
1409
1410 (defun sas-move-to-filename (&optional eol)
1411   (or eol (setq eol (progn (end-of-line) (point))))
1412   (beginning-of-line)
1413   (if (re-search-forward "\\(^ *[0-9]+ *<*\\)[^:0-9\n]" eol t)
1414         (goto-char (match-end 1))))
1415
1416 (defun sas-next-line (arg)
1417   "Move down one line."
1418   (interactive "p")
1419   (forward-line arg)
1420   (sas-move-to-filename (point-max)))
1421 ;;(and (< (point) sas-dir-buf-end)
1422   ;;(forward-line arg)
1423   ;;(sas-move-to-filename sas-dir-buf-end)))
1424
1425 (defun sas-prev-line (arg)
1426   "Move up one line."
1427   (interactive "p")
1428   (beginning-of-line)
1429   (re-search-backward "^ *[0-9]+ *<*[^:0-9\n]" (point-min) t)
1430   (sas-move-to-filename sas-dir-buf-end))
1431
1432 (defun sas-insert-set-properties (beg end)
1433   (save-excursion
1434     (goto-char beg)
1435     (while (< (point) end)
1436       (if (sas-move-to-filename)
1437           (put-text-property (point)
1438                              (+ 8 (point))
1439                              'mouse-face 'highlight))
1440       (forward-line 1))))
1441
1442 (defun sas-get-filename ()
1443   "Return name of dataset on current line."
1444   (interactive)
1445   (save-excursion
1446     (if (string-equal "*SAS-dir" (substring (buffer-name) 0 8))
1447         (sas-move-to-filename)
1448       (goto-char (point-min))
1449       (re-search-forward "Data Set Name: [^.]*\\."))
1450     (expand-file-name
1451      (downcase (concat sas-directory-name
1452                        (buffer-substring
1453                         (point)
1454                         (save-excursion
1455                           (skip-chars-forward "A-Z0-9_")
1456                           (point))) ".ssd01")))))
1457
1458 (defun sas-get-file-number ()
1459   "Return name of dataset on current line."
1460   (interactive)
1461   (if (sas-move-to-filename)
1462       (progn (forward-word -1)
1463              (re-search-forward "[0-9]*")
1464              (string-to-number
1465               (buffer-substring (match-beginning 0)
1466                                 (match-end 0))))))
1467
1468 ;;(defun sas-contents ()
1469 ;;  "Run proc contents on current file."
1470 ;;  (interactive)
1471 ;;  (let ((buffer-read-only nil) (sas-get-options "linesize=70"))
1472 ;;    (sas-get-dataset (sas-get-filename) 2 t t (buffer-name))
1473 ;;    (end-of-buffer)
1474 ;;    (backward-page-top-of-window 1)))
1475 ;;
1476 ;;(defun sas-print ()
1477 ;;  "Run proc contents on current file."
1478 ;;  (interactive)
1479 ;;  (sas-get-dataset (sas-get-filename) 1 nil nil nil
1480 ;;                   (sas-create-var-string)))
1481
1482 (defun sas-goto-page (arg)
1483   "Goto top of page ARG.  If no ARG, then goto top of file."
1484   (interactive "P")
1485   (goto-char 1)
1486   (if arg
1487       (if (> arg 1)
1488           (progn
1489             (re-search-forward page-delimiter (point-max) 1 (1- arg)))))
1490   (skip-chars-forward sas-white-chars); was " \f\n" till 5.1.13
1491   (recenter 1))
1492
1493 (defun forward-page-top-of-window (arg)
1494   "Move forward to page boundary and leave first line at top of window.
1495 With arg, repeat, or go back if negative. A page boundary is any line
1496 whose beginning matches the regexp `page-delimiter'."
1497   (interactive "p")
1498   (forward-page arg)
1499   (recenter 0))
1500
1501 (defun backward-page-top-of-window (arg)
1502   "Move backward to page boundary and leave first line at top of window.
1503 With arg, repeat, or go back if negative. A page boundary is any line
1504 whose beginning matches the regexp `page-delimiter'."
1505   (interactive "p")
1506   (forward-page (- arg))
1507   (recenter 0))
1508
1509 (defun sas-narrow-to-page ()
1510   (save-excursion
1511     (let* ((min (point-min))
1512            (max (point-max)))
1513       ;;(omin (point-min))
1514       ;;(omax (point-max)))
1515       (if (or (bolp) (beginning-of-line)
1516               (looking-at page-delimiter))
1517           (forward-char 1)
1518         (forward-page -1))
1519       (setq min (point))
1520       (forward-page 1)
1521       (beginning-of-line)
1522       (setq max (point))
1523       (narrow-to-region min max))))
1524
1525 (defun sas-forward-page-narrow (arg)
1526   "Move forward to page boundary and narrow to page.
1527 With arg, repeat, or go back if negative. A page boundary is any line
1528 whose beginning matches the regexp `page-delimiter'."
1529   (interactive "p")
1530   (widen)
1531   (forward-page arg)
1532   (sas-narrow-to-page)
1533   (goto-char (point-min)))
1534
1535 (defun sas-backward-page-narrow (arg)
1536   "Move backward to page boundary and narrow to page.
1537 With arg, repeat, or go back if negative. A page boundary is any line
1538 whose beginning matches the regexp `page-delimiter'."
1539   (interactive "p")
1540   (goto-char (point-min))
1541   (widen)
1542   (forward-page (- arg))
1543   (sas-narrow-to-page))
1544
1545 (defun sas-goto-dataset (&optional page)
1546   (interactive)
1547   (and sas-directory-name
1548        (let ((page (or page (sas-get-file-number))))
1549              ;;(dir sas-directory-name))
1550          (if page
1551              (progn
1552                (switch-to-buffer-other-window
1553                 (concat "*SAS-cont-" sas-directory-name))
1554                (widen)
1555                (sas-goto-page page)
1556                (sas-narrow-to-page)
1557                (goto-char (point-min)))))))
1558
1559 ;;(defun sas-mouse-goto-dataset (event)
1560 ;;  (interactive "e")
1561 ;;  (let (page buf)
1562 ;;    (save-window-excursion
1563 ;;      (save-excursion
1564 ;;        (set-buffer (window-buffer (posn-window (event-end event))))
1565 ;;        (save-excursion
1566 ;;          (goto-char (posn-point (event-end event)))
1567 ;;          (setq page (sas-get-file-number)))
1568 ;;        (sas-goto-dataset page)
1569 ;;        (setq buf (buffer-name))))
1570 ;;    (set-buffer buf)
1571 ;;    (goto-char (point-min))
1572 ;;    (display-buffer buf)))
1573
1574
1575 (defun sas-dir-goto-page (page)
1576   (interactive "p")
1577   (widen)
1578   (sas-goto-page page)
1579   (sas-narrow-to-page))
1580
1581 (defun sas-mark-item (&optional next)
1582   (interactive)
1583   (sas-move-to-filename)
1584   (beginning-of-line)
1585   (let ((buffer-read-only nil))
1586     (if (re-search-forward "^\\( *[0-9]+ *\\) \\([A-Z][A-Z_0-9]*\\) "
1587                            (save-excursion (end-of-line) (point)) t)
1588         (replace-match "\\1<\\2>")))
1589   (or next (sas-next-line 1)))
1590
1591 (defun sas-unmark-item ()
1592   (interactive)
1593   (save-excursion
1594     (beginning-of-line)
1595     (let ((buffer-read-only nil))
1596       (if (re-search-forward "^\\( *[0-9]+ *\\)<\\([A-Z][A-Z_0-9]*\\)>"
1597                              (save-excursion (end-of-line) (point)) t)
1598           (replace-match "\\1 \\2 ")))))
1599
1600 (defun sas-prev-line-undo (arg)
1601   (interactive "p")
1602   (sas-prev-line arg)
1603   (sas-unmark-item)
1604   (sas-move-to-filename))
1605
1606 (defun sas-create-var-string ()
1607   (and (string-equal "*SAS-cont" (substring (buffer-name) 0 9))
1608        (let (str)
1609          (goto-char (point-min))
1610          (while
1611              (re-search-forward "^\\( *[0-9]+ *\\)<\\([A-Z][A-Z_0-9]*\\)>"
1612                                 nil t)
1613            (setq str (concat str " " (buffer-substring (match-beginning 2)
1614                                                        (match-end 2)))))
1615          str)))
1616
1617 ;;(defun sas-revert-library ()
1618 ;;  "Update current library."
1619 ;;  (interactive)
1620 ;;  (if sas-directory-name
1621 ;;      (sas-make-library sas-directory-name t)))
1622
1623 (provide 'essl-sas)
1624
1625 \f ; Local variables section
1626
1627 ;;; This file is automatically placed in Outline minor mode.
1628 ;;; The file is structured as follows:
1629 ;;; Chapters:     ^L ;
1630 ;;; Sections:    ;;*;;
1631 ;;; Subsections: ;;;*;;;
1632 ;;; Components:  defuns, defvars, defconsts
1633 ;;;              Random code beginning with a ;;;;* comment
1634 ;;; Local variables:
1635 ;;; mode: emacs-lisp
1636 ;;; mode: outline-minor
1637 ;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
1638 ;;; End:
1639
1640 ;;; essl-sas.el ends here