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