CoCalc -- ess-sas-l.el

²⁷⁰¹ views
1
;;; ess-sas-l.el --- SAS customization
2

3
;; Copyright (C) 1997--2009 A.J. Rossini, Richard M. Heiberger, Martin
4
;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
5

6
;; Authors: Richard M. Heiberger
7
;;          A.J. Rossini
8
;;          Rodney Sparapani
9
;; Created: 20 Aug 1997
10
;; Maintainer: ESS-core <[email protected]>
11

12
;; Keywords: languages
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
;; A copy of the GNU General Public License is available at
27
;; http://www.r-project.org/Licenses/
28

29

30
;;; Commentary:
31

32
;; This is based upon Version 1.4 of SAS mode:
33

34

35
;;;    sas-mode:  indent, run etc, SAS programs.
36
;;;    Copyright (C) 1994--1997 Tom Cook
37
;;;  Author:   Tom Cook
38
;;;            Dept. of Biostatistics
39
;;;            University of Wisconsin - Madison
40
;;;            Madison, WI 53706
41
;;;            [email protected]
42
;;;
43
;;;  Acknowledgements:
44
;;;  Menu code for XEmacs/Lucid emacs and startup mods
45
;;;  contributed by [email protected]
46
;;;
47
;;; Last change: 2/1/95
48
;;; Last change: 01/15/02
49

50
;;; Code:
51

52
(ess-message "[ess-sas-l:] (require 'ess) ...")
53
(require 'ess)
54
(ess-message "[ess-sas-l:] (require 'ess-mode) ...")
55
(require 'ess-mode)
56
(require 'ess-custom)
57

58
(ess-message "[ess-sas-l:] (autoload ..) (def** ..) etc ...")
59

60
(autoload 'ess-transcript-mode "ess-trns" "ESS source eval mode." t)
61

62
(put 'ess-transcript-minor-mode 'permanent-local t)
63
(or (assq 'ess-transcript-minor-mode minor-mode-alist)
64
    (setq minor-mode-alist
65
          (append minor-mode-alist
66
                  (list '(ess-transcript-minor-mode " ESStr")))))
67

68
(put 'ess-listing-minor-mode 'permanent-local t)
69
(or (assq 'ess-listing-minor-mode minor-mode-alist)
70
    (setq minor-mode-alist
71
          (append minor-mode-alist
72
                  (list '(ess-listing-minor-mode " ESSlst")))))
73

74
(defun ess-transcript-minor-mode (&optional arg)
75
  "Toggle Ess-Transcript minor mode.
76
With arg, turn Ess-Transcript minor mode on if arg is positive, off
77
otherwise.  See the command `ess-transcript-mode' for more information
78
on this mode."
79
  (interactive "P")
80
  (setq ess-transcript-minor-mode
81
        (if (null arg) (not ess-transcript-minor-mode)
82
          (> (prefix-numeric-value arg) 0)))
83
  (force-mode-line-update)
84
  (setq mode-line-process
85
        '(" [" ess-local-process-name "]")))
86

87
(defun ess-listing-minor-mode (&optional arg)
88
  "Toggle Ess-Listing minor mode.
89
With arg, turn Ess-Listing minor mode on if arg is positive, off
90
otherwise.  Ess-Listing mode is used solely to place an indicator on
91
the mode line."
92
  (interactive "P")
93
  (setq ess-listing-minor-mode
94
        (if (null arg) (not ess-listing-minor-mode)
95
          (> (prefix-numeric-value arg) 0)))
96
  (force-mode-line-update)
97
  (setq mode-line-process
98
        '(" [" ess-local-process-name "]")))
99
        
100
(defcustom ess-automatic-sas-log-or-lst-mode t
101
  "Automatically turn on `SAS-log-mode' and `SAS-listing-mode' when enabled."
102
  :type 'boolean
103
  :group 'ess-sas)
104

105
(defun ess-SAS-log-mode-p ()
106
  "Return t when when a SAS log file is detected.
107
A SAS log is defined as having:
108

109
1. The first line matches \"^1[ \t]*The SAS System\"
110
2. The file name ends in .log.
111
"
112
  (and ess-automatic-sas-log-or-lst-mode
113
       (save-excursion
114
         (goto-char (point-min))
115
         (looking-at "1[ \t]*The SAS System"))
116
       (if (buffer-file-name)
117
           (string-match ".log$" (buffer-file-name))
118
         t)))
119

120
(defun ess-SAS-listing-mode-p ()
121
  "Return t when SAS listing file is detected.
122
A .lst file is a SAS listing file when:
123

124
1. The file name ends in .lst
125
2. The corresponding log file exists and is a SAS log file.
126
"
127
  (when ess-automatic-sas-log-or-lst-mode
128
    (let* ((bfn (buffer-file-name))
129
           (log (and bfn
130
                     (string-match-p "\\.lst$" bfn)
131
                     (replace-regexp-in-string "\\.lst$" ".log" bfn))))
132
      (and log
133
           (file-exists-p log)
134
           (with-temp-buffer
135
             (insert-file-contents log nil 0 200)
136
             (goto-char (point-min))
137
             (looking-at "1[ \t]*The SAS System"))))))
138

139
(add-to-list 'magic-mode-alist
140
             '(ess-SAS-log-mode-p . SAS-log-mode))
141
(add-to-list 'magic-mode-alist
142
             '(ess-SAS-listing-mode-p . SAS-listing-mode))
143

144
(defun SAS-log-mode ()
145
  "`ess-transcript-mode' for SAS."
146
  (interactive)
147
  (SAS-mode)
148
  (setq mode-name "ESS[LOG]")
149
  (ess-transcript-minor-mode 1)
150
  (setq buffer-read-only t)) ;; to protect the buffer.
151

152
(defun SAS-listing-mode()
153
  "Fundamental mode with `ess-listing-minor-mode' and read-only."
154
  (interactive)
155
  (fundamental-mode)
156
  (setq mode-name "ESS[LST]")
157
  (ess-listing-minor-mode 1)
158
  (use-local-map sas-mode-local-map)
159
  (setq buffer-read-only t)) ;; to protect the buffer.
160

161
(fset 'sas-log-mode        'SAS-log-mode)
162
(fset 'SAS-transcript-mode 'SAS-log-mode)
163
(fset 'sas-transcript-mode 'SAS-log-mode)
164
(fset 'sas-mode 'SAS-mode)
165
(fset 'sas-listing-mode    'SAS-listing-mode)
166

167
(defcustom  sas-indent-width 4
168
  "*Amount to indent sas statements."
169
  :group 'ess-sas
170
  :type  'integer)
171

172
(defcustom sas-indent-ignore-comment "*"
173
  "*Comments that start with this string are ignored in indentation."
174
  :group 'ess-sas
175
  :type  'string)
176

177
(defcustom sas-require-confirmation t
178
  "*Require confirmation when revisiting a modified sas-output file."
179
  :group 'ess-sas
180
  :type  'boolean)
181

182
;; user can specify the sas program name
183
(defcustom sas-program
184
  (if (equal system-type 'Apple-Macintosh) "invoke SAS using program file" "sas")
185
  "*Command to invoke SAS, default for buffer-local `ess-sas-submit-command'."
186
  :group 'ess-sas
187
  :type  'string)
188

189
(defcustom sas-pre-run-hook nil
190
  "Hook to execute prior to running SAS via `submit-sas'."
191
  :group 'ess-sas
192
  :type  'hook)
193

194
                                        ;never used--see ess-sas-submit-command-options in ess-sas-a.el
195
                                        ;(defcustom sas-options-string ""
196
                                        ;  "*Options to be passed to sas as if typed on the command line."
197
                                        ;  :group 'ess-sas
198
                                        ;  :type  'string)
199

200
(defcustom sas-notify t
201
  "*Beep and display message when job is done."
202
  :group 'ess-sas
203
  :type  'boolean)
204

205
(defcustom sas-error-notify t
206
  "*If `sas-notify' t, indicate errors in log file upon completion."
207
  :group 'ess-sas
208
  :type  'boolean)
209

210
(defcustom sas-get-options nil
211
  "Options to be passed to SAS in sas-get-dataset."
212
  :group 'ess-sas
213
  :type '(choice (const nil) string))
214

215
(defcustom sas-get-options-history nil
216
  "History list of Options passed to SAS in sas-get-dataset."
217
  :group 'ess-sas)
218

219
(defcustom sas-page-number-max-line 3
220
  "*Number of lines from the page break, to search for the page
221
number."
222
  :group 'ess-sas
223
  :type  'integer)
224

225
(defcustom sas-notify-popup nil
226
  "*If this and sas-notify are t), popup a window when SAS job ends."
227
  :group 'ess-sas
228
  :type  'boolean)
229

230
(defcustom sas-tmp-libname "_tmp_"
231
  "*Libname to use for sas-get-dataset."
232
  :group 'ess-sas
233
  :type  'string)
234

235
(defcustom sas-file-name nil
236
  "*The name of the current sas file."
237
  :group 'ess-sas
238
  :type '(choice (const nil) file))
239

240
;; The next two are ``the inside of [...] in a regexp'' to be used in
241
;; (skip-chars-(for|back)ward SAS-..-chars)
242
(defcustom sas-white-chars " \t\n\f"
243
  "This does NOT escape blanks (RMH, 2000/03/20)."
244
  :group 'ess-sas
245
  :type  'string)
246

247
(defcustom sas-comment-chars (concat sas-white-chars ";")
248
  "Doc?"
249
  :group 'ess-sas
250
  :type  'string)
251

252
(defcustom ess-sas-run-regexp-opt t
253
  "If you do not want to run regexp-opt, then set to nil."
254
  :group 'ess-sas
255
  :type '(choice (const nil) string))
256

257
(require 'ess-sas-a)
258

259
(defvar sas-buffer-name nil)
260
(defvar sas-file-root nil)
261
(defvar sas-submitable nil)
262
(defvar sas-dataset nil)
263
(defvar SAS-syntax-table nil "Syntax table for SAS code.")
264

265
(if SAS-syntax-table nil
266
  (setq SAS-syntax-table (make-syntax-table))
267

268
  ;; (if (equal system-type 'windows-nt)
269
  ;;     ;; backslash is punctuation (used in MS file names)
270
  ;;     (modify-syntax-entry ?\\ "."  SAS-syntax-table)
271
  ;;    ;; backslash is an escape character
272
  ;;    (modify-syntax-entry ?\\ "\\" SAS-syntax-table))
273
  (modify-syntax-entry ?\\ "."  SAS-syntax-table)  ;; backslash is punctuation
274
  (modify-syntax-entry ?+  "."  SAS-syntax-table)
275
  (modify-syntax-entry ?-  "."  SAS-syntax-table)
276
  (modify-syntax-entry ?=  "."  SAS-syntax-table)
277
  (modify-syntax-entry ?%  "w"  SAS-syntax-table)
278
  (modify-syntax-entry ?<  "."  SAS-syntax-table)
279
  (modify-syntax-entry ?>  "."  SAS-syntax-table)
280
  (modify-syntax-entry ?&  "w"  SAS-syntax-table)
281
  (modify-syntax-entry ?|  "."  SAS-syntax-table)
282
  (modify-syntax-entry ?\' "\"" SAS-syntax-table)
283
  (modify-syntax-entry ?*  ". 23"  SAS-syntax-table) ; comment character
284
  (modify-syntax-entry ?\; "."  SAS-syntax-table)
285
  (modify-syntax-entry ?_  "w"  SAS-syntax-table)
286
  (modify-syntax-entry ?<  "."  SAS-syntax-table)
287
  (modify-syntax-entry ?>  "."  SAS-syntax-table)
288
  (modify-syntax-entry ?/  ". 14"  SAS-syntax-table) ; comment character
289
  (modify-syntax-entry ?.  "w"  SAS-syntax-table))
290

291
(require 'font-lock); fontification also works in terminals!
292
;; (if (or window-system
293
;;      noninteractive) ; compilation!
294
;;; ...
295

296

297
(defvar SAS-mode-font-lock-defaults
298
  (if ess-sas-run-regexp-opt
299
      (list
300
       ;; .log NOTE: messages
301
       (cons "^NOTE [0-9]+-[0-9]+: Line generated by the invoked macro"
302
             font-lock-comment-face)
303
       (cons "^NOTE: .*$"                          font-lock-comment-face)
304
       (cons "^      [^ @].*[.]$"                   font-lock-comment-face)
305
       (cons "^      [a-z].*[a-z][ ]?$"            font-lock-comment-face)
306
       (cons "^      Engine:[ ]+V.+$"              font-lock-comment-face)
307
       (cons "^      Physical Name:[ ]+.+$"        font-lock-comment-face)
308
       (cons "^      \\(cpu\\|real\\) time[ ]+[0-9].*$"
309
             font-lock-comment-face)
310
       (cons "^      decimal may be shifted by the"
311
             font-lock-comment-face)
312
       (cons "^NOTE: The infile "                  font-lock-comment-face)
313
       (cons "^NOTE: 1 record was read from the infile "
314
             font-lock-comment-face)
315
       (cons "^NOTE: [1-9][0-9]* records were read from the infile "
316
             font-lock-comment-face)
317
       (cons "^      Filename=.*,$"                font-lock-comment-face)
318
       (cons "^      File Name=.*,$"               font-lock-comment-face)
319
       (cons "^      File $"                       font-lock-comment-face)
320
       (cons "^      Name=.*,$"                    font-lock-comment-face)
321
       (cons "^      File List=("                  font-lock-comment-face)
322
       (cons "^      List=("                       font-lock-comment-face)
323
       (cons "^      Owner Name=.*,$"              font-lock-comment-face)
324
       (cons "^      Access Permission=.*,$"       font-lock-comment-face)
325
       (cons "^      Last Modified=.*,?$"          font-lock-comment-face)
326
       (cons "^      File Size (bytes)=[0-9]+$"    font-lock-comment-face)
327
       (cons "^      Pipe command="                font-lock-comment-face)
328
       (cons "^NOTE: The file "                    font-lock-comment-face)
329
       (cons "^NOTE: 1 record was written to the file "
330
             font-lock-comment-face)
331
       (cons "^NOTE: [1-9][0-9]* records were written to the file "
332
             font-lock-comment-face)
333
       (cons "^NOTE: PROC LOGISTIC is modeling the probability that"
334
             font-lock-comment-face)
335
       (cons "^NOTE: PROC GENMOD is modeling the probability that"
336
             font-lock-comment-face)
337
       (cons "^1[ ]+The SAS System.*$"             font-lock-comment-face)
338
       (cons "^\014.*$"                            font-lock-comment-face)
339
       (cons "[*][*][*] ANNOTATE macros are now available [*][*][*]"
340
             font-lock-comment-face)
341
       (cons "For further information on ANNOTATE macros, enter,"
342
             font-lock-comment-face)
343
       ;; (cons "^SAS/STAT 9.3_M1, SAS/ETS 9.3_M1, SAS/OR 9.3_M1"
344
       ;;       font-lock-comment-face)
345
       (cons "\\(or \\)?%HELPANO.*$"
346
             font-lock-comment-face)
347
       (cons "^Local Variables:$"                  font-lock-comment-face)
348
       (cons "^End:$"                              font-lock-comment-face)
349
       (cons "^MPRINT([_A-Z0-9]+)"                 font-lock-comment-face)
350

351
       ;; .log ERROR: messages
352
                                        ;     (cons "^ERROR\\( [0-9]+-[1-9][0-9][0-9]\\)?: .*$"
353
       (cons "^ERROR\\( [0-9]+-[0-9]+\\)?: .*$"
354
             font-lock-keyword-face)
355
                                        ;       ERROR:
356
       (cons "^       [^ @].*\\([.][ ]?[ ]?\\|[,a-z][ ]\\)$"
357
             font-lock-keyword-face)
358
                                        ;       ERROR #-###:
359
       (cons "^             [^ @].*\\([.][ ]?[ ]?\\|[,a-z][ ]\\)$"
360
             font-lock-keyword-face)
361
                                        ;       ERROR ##-###:
362
       (cons "^              [^ @].*\\([.][ ]?[ ]?\\|[,a-z][ ]\\)$"
363
             font-lock-keyword-face)
364
                                        ;       ERROR ###-###:
365
       (cons "^               [^ @].*\\([.][ ]?[ ]?\\|[,a-z][ ]\\)$"
366
             font-lock-keyword-face)
367
       (cons "^              a format name."       font-lock-keyword-face)
368
       (cons "^       where a numeric operand is required. The condition was: "
369
             font-lock-keyword-face)
370
       (cons "[ ][_]+$"                            font-lock-keyword-face)
371

372
       ;; .log WARNING: messages
373
                                        ;(cons "^WARNING\\( [0-9]+-[1-9][0-9][0-9]\\)?: .*$"
374
       (cons "^WARNING\\( [0-9]+-[0-9]+\\)?: .*$"
375
             font-lock-function-name-face)
376
                                        ;       WARNING:
377
       (cons "^         [^ @].*\\([.][ ]?[ ]?\\|[,a-z][ ]\\)$"
378
             font-lock-function-name-face)
379
                                        ;       WARNING #-###:
380
       (cons "^               [^ @].*\\([.][ ]?[ ]?\\|[,a-z][ ]\\)$"
381
             font-lock-function-name-face)
382
                                        ;       WARNING ##-###:
383
       (cons "^                [^ @].*\\([.][ ]?[ ]?\\|[,a-z][ ]\\)$"
384
             font-lock-function-name-face)
385
                                        ;       WARNING ###-###:
386
       (cons "^                 [^ @].*\\([.][ ]?[ ]?\\|[,a-z][ ]\\)$"
387
             font-lock-function-name-face)
388

389
       ;; SAS comments
390
       ;; /* */ style handled by grammar above
391
       (cons "\\(^[0-9]*\\|[:;!]\\)[ \t]*%?\\*[^;/][^;]*;"
392
             font-lock-comment-face)
393

394
                                        ; these over-rides need to come before the more general declarations
395
       (cons "\\<and("      font-lock-function-name-face)
396
       (cons "\\<data="     font-lock-keyword-face)
397
       (cons "\\<in:("      font-lock-function-name-face)
398
       (cons "\\<index("    font-lock-function-name-face)
399
       (cons "\\<input("    font-lock-function-name-face)
400
       (cons "\\<libname("  font-lock-function-name-face)
401
       (cons "\\<not("      font-lock-function-name-face)
402
       (cons "\\<or("       font-lock-function-name-face)
403
       (cons "\\<put("      font-lock-function-name-face)
404
       (cons "\\<sum("      font-lock-function-name-face)
405

406
                                        ; other idiosyncratic keywords
407
                                        ;(cons "key="      font-lock-keyword-face)
408
                                        ;(cons "/unique"   font-lock-keyword-face)
409

410
       ;; SAS execution blocks: DATA, %MACRO/%MEND, %DO/%END, etc.
411
       (cons (regexp-opt '(
412
                           "data" ;"proc"
413
                           "%macro" "%mend"
414
                           "%do" "%to" "%by" "%end"
415
                           "%goto" "%go to"
416
                           "%if" "%then" "%else"
417
                           "%global" "%inc" "%include" "%input" "%local" "%let" "%put" "%sysexec"
418
                           ) 'words) font-lock-constant-face)
419

420
       ;; SAS execution blocks that must be followed by a semi-colon
421
       (cons (concat "\\<"
422
                     (regexp-opt
423
                      '(
424
                        "run;" "quit;" "endsas;"
425
                        "cards;" "cards4;" "datalines;" "datalines4;" "lines;" "lines4;"
426
                        )))
427
             font-lock-constant-face)
428

429
       ;; SAS statements that must be followed by a semi-colon
430
       (cons (concat "\\<"
431
                     (regexp-opt
432
                      '(
433
                        "end;" "list;" "lostcard;" "page;" "return;" "stop;"
434
                        )))
435
             font-lock-keyword-face)
436

437
       ;; SAS statements that must be followed by an equal sign
438
       (cons (concat "\\<"
439
                     (regexp-opt
440
                      '(
441
                        "compress=" "in=" "out=" "sortedby="
442
                        )))
443
             font-lock-keyword-face)
444

445
;;;    ;; SAS procedure names
446
       (cons (concat "\\<proc[ ]+"
447
                     (regexp-opt '(
448
                                   ;; SAS base and SAS/Graph
449
                                   "append"
450
                                   "calendar" "catalog" "chart" "cimport" "cport" "compare" "contents" "copy" "corr"
451
                                   "datasets" "dbcstab" "display"
452
                                   "explode" "export"
453
                                   "fcmp" "format" "forms" "freq" "fsbrowse" "fsedit" "fsletter" "fslist" "fsview"
454
                                   "ganno" "gchart" "gcontour" "gdevice" "geocode" "gfont" "gimport" "ginside"
455
                                   "gkeymap" "gmap" "goptions" "gplot" "gprint" "gproject" "greduce" "gremove"
456
                                   "greplay" "gslide" "gtestit" "g3d" "g3grid"
457
                                   "iml" "import" "insight"
458
                                   "mapimport" "means"
459
                                   "options"
460
                                   "plot" "pmenu" "print" "printto"
461
                                   "rank" "registry" "report"
462
                                   "setinit" "sgdesign" "sgpanel" "sgplot" "sgrender" "sgscatter" "sort" "sql" "standard" "summary"
463
                                   "tabulate" "template" "timeplot" "transpose" "trantab"
464
                                   "univariate"
465

466
                                   ;;SAS/Stat and SAS/ETS
467
                                   "aceclus" "anova" "arima" "autoreg"
468
                                   "bgenmod" "blifereg" "boxplot" "bphreg"
469
                                   "calis" "cancorr" "candisc" "catmod" "citibase" "cluster" "computab" "corresp" "countreg"
470
                                   "discrim" "distance"
471
                                   "entropy" "expand"
472
                                   "factor" "fastclus" "forecast"
473
                                   "gam" "genmod" "glimmix" "glm" "glmmod" "glmpower" "glmselect"
474
                                   "hpmixed"
475
                                   "inbreed"
476
                                   "kde" "krige2d"
477
                                   "lattice" "lifereg" "lifetest" "loess" "logistic"
478
                                   "mcmc" "mdc" "mds" "mi" "mianalyze" "mixed" "modeclus" "model" "mortgage" "multtest"
479
                                   "nested" "nlin" "nlmixed" "npar1way"
480
                                   "orthoreg"
481
                                   "panel" "pdlreg" "phreg" "plan" "plm" "pls" "power" "princomp" "prinqual" "probit"
482
                                   "qlim" "quantreg"
483
                                   "reg" "risk" "robustreg" "rsreg"
484
                                   "score" "seqdesign" "seqtest" "severity" "sim2d" "similarity" "simlin" "simnormal"
485
                                   "spectra" "statespace" "stdize" "stepdisc"
486
                                   "surveyfreq" "surveylogistic" "surveymeans" "surveyphreg" "surveyreg" "surveyselect" "syslin"
487
                                   "tcalis" "timeid" "timeseries" "tphreg" "tpspline" "transreg" "tree" "ttest"
488
                                   "ucm"
489
                                   "varclus" "varcomp" "variogram" "varmax"
490
                                   "x11" "x12"
491
                                   ) 'words)) font-lock-constant-face)
492

493
                                        ;       (cons (concat
494
                                        ;             "\\<"
495
                                        ;             "do[ \t]*" (regexp-opt '("over" "until" "while") t) "?"
496
                                        ;             "\\>")
497
                                        ;            font-lock-keyword-face)
498
                                        ;
499
       ;; SAS base and SAS/Graph statements
500
       (cons (concat ;"\\<"
501
              (regexp-opt
502
               '(
503
                 "do" "to" "by" "goto" ; "go"
504
                 "abort" "and" "array" "assess" "attrib"
505
                 "baseline" "bayes" "between" "bivar" "block" "bubble" "bubble2"
506
                 "change" "choro" "class" "contains" "contrast"
507
                 "delete" "display" "dm" "donut" "drop"
508
                 "else" "error" "exchange" "exclude"
509
                 "file" "filename" "format" "freq"
510
                 "footnote" "footnote1" "footnote2" "footnote3" "footnote4" "footnote5"
511
                 "footnote6" "footnote7" "footnote8" "footnote9" "footnote10"
512
                 "goptions" "grid" ; "ge" "gt"
513
                 "hazardratio" "hbar" "hbar3d"
514
                 "id" "if" "index" "infile" "informat" "input" ; "is" rarely used, but common false pos.
515
                 "keep"
516
                 "label" "length" "libname" "like" "link" "lsmeans" ; "le" "lt"
517
                 "manova" "means" "merge" "missing" "model" "modify"
518
                 "not" "null" ; "ne" "note"
519
                 "ods" "options" "or" "output" "otherwise"
520
                 "pageby" "pie" "pie3d" "plot" "plot2" "prism" "put"
521
                 "random" "rename" "repeated" "retain"
522
                 "same" "save" "scatter" "select" "set" "skip" "star" "strata" "sum" "sumby" "surface"
523
                 "table" "tables" "test" "then" "time"
524
                 "title" "title1" "title2" "title3" "title4" "title5"
525
                 "title6" "title7" "title8" "title9" "title10"
526
                 "univar" "update"
527
                 "value" "var" "vbar" "vbar3d"
528
                 "weight" "where" "window" "with"
529
                                        ; "x"
530
                 ) 'words)) ;"\\>")
531
             font-lock-keyword-face)
532

533
       ;; SAS/GRAPH statements not handled above
534
       (cons (concat "\\<"
535
                     (regexp-opt
536
                      '("axis" "legend" "pattern" "symbol")) "\\([1-9][0-9]?\\)?"
537
                      "\\>")
538
             font-lock-keyword-face)
539

540
       ;; SAS functions and SAS macro functions
541
       (cons "%[a-z_][a-z_0-9]*[(;]"                  font-lock-function-name-face)
542
                                        ;(cons "\\<call[ \t]+[a-z]+("                   font-lock-function-name-face)
543

544
       (cons (concat ;"\\<"
545
              (regexp-opt
546
               '(
547
                 "abs" "arcos" "arsin" "atan"
548
                 "betainv" "byte"
549
                 "call execute" "call label" "call module" "call modulei"
550
                 "call poke" "call ranbin" "call rancau" "call ranexp"
551
                 "call rangam" "call rannor" "call ranpoi" "call rantbl"
552
                 "call rantri" "call ranuni" "call rxchange" "call rxfree"
553
                 "call rxsubstr" "call set" "call symput" "call system"
554
                 "cdf" "ceil" "cinv" "collate" "compress" "convx" "convxp" "cos" "cosh" "css" "cv"
555
                 "daccdb" "daccdbsl" "daccsl" "daccsyd" "dacctab"
556
                 "depdb" "depdbsl" "depsl" "depsyd" "deptab"
557
                 "date" "datejul" "datepart" "datetime" "day" "dhms" "dif" "digamma" "dim"
558
                 "erf" "erfc" "exp"
559
                 "finv" "fipname" "fipnamel" "fipstate" "floor" "fuzz"
560
                 "gaminv" "gamma"
561
                 "hbound" "hms" "hour"
562
                 "in" "index" "indexc" "input" "int" "intck" "intnx" "intrr" "irr"
563
                 "juldate"
564
                 "kurtosis"
565
                 "lag" "lbound" "left" "length" "lgamma" "log" "log10" "log2"
566
                 "max" "mdy" "mean" "min" "minute" "mod" "month" "mort"
567
                 "n" "netpv" "nmiss" "normal" "npv"
568
                 "ordinal"
569
                 "probbeta" "probbnml" "probchi" "probf" "probgam" "probhypr" "probit" "probnegb" "probnorm" "probt"
570
                 "poisson" "put"
571
                 "qtr"
572
                 "range" "rank" "repeat" "reverse" "right" "round" "rxmatch" "rxparse"
573
                 "ranbin" "rancau" "ranexp" "rangam" "rannor" "ranpoi" "rantbl" "rantri" "ranuni"
574
                 "saving" "scan" "second" "sign" "sin" "sinh" "sqrt"
575
                 "std" "stderr" "stfips" "stname" "stnamel" "substr" "sum" "symget"
576
                 "tan" "tanh" "time" "timepart" "tinv" "today" "translate" "trigamma" "trim" "trunc"
577
                 "uniform" "until" "upcase" "uss"
578
                 "var" "verify"
579
                 "weekday" "when" "while"
580
                 "year" "yyq"
581
                 "zipfips" "zipname" "zipnamel" "zipstate"
582

583
;;;    ;; SAS functions introduced in Technical Report P-222
584
                 "airy"
585
                 "band" "blshift" "brshift" "bnot" "bor" "bxor"
586
                 "cnonct" "compbl"
587
                 "dairy" "dequote"
588
                 "fnonct"
589
                 "ibessel" "indexw" "inputc" "inputn"
590
                 "jbessel"
591
                 "lowcase"
592
                 "putc" "putn"
593
                 "quote"
594
                 "resolve"
595
                 "soundex" "sysprod"
596
                 "tnonct" "tranwrd" "trimn"
597

598
;;;    ;; SCL functions that are known to work with SAS macro function %sysfunc
599
                 "attrc" "attrn"
600
                 "cexist" "close"
601
                 "dclose" "dnum" "dopen" "dread"
602
                 "exist"
603
                 "fclose" "fetchobs" "fileexist" "finfo" "fopen" "fput" "fwrite"
604
                 "getoption" "getvarc" "getvarn"
605
                 "libname" "libref"
606
                 "open" "optgetn" "optsetn"
607
                 "pathname"
608
                 "sysmsg"
609
                 "varfmt" "varlabel" "varnum" "vartype"
610
                 ) 'words) ;"\\>"
611
              "("); "[ \t]*(")
612
             font-lock-function-name-face)
613
       )
614
    (list
615
     ;; .log NOTE: messages
616
     (cons "^NOTE: .*$"                         font-lock-constant-face)
617

618
     ;; .log ERROR: messages
619
     (cons "^ERROR: .*$"                        font-lock-keyword-face)
620

621
     ;; .log WARNING: messages
622
     (cons "^WARNING: .*$"                      font-lock-function-name-face)
623

624
     ;; SAS comments
625
     ;; /* */ handled by grammar above
626
     ;;  (list "/\\*.*\\*/"                      0  font-lock-comment-face t)
627
     (cons "\\(^[0-9]*\\|;\\)[ \t]*\\(%?\\*\\|comment\\).*\\(;\\|$\\)" font-lock-comment-face)
628

629
     ;; SAS execution blocks, DATA/RUN, PROC/RUN, SAS Macro Statements
630
     (cons "\\<%do[ \t]*\\(%until\\|%while\\)?\\>"
631
           font-lock-constant-face)
632
     ;;(cons (concat "\\(^[0-9]*\\|;\\)[ \t]*"
633
     ;;"%\\(end\\|global\\|local\\|m\\(acro\\|end\\)\\)"
634
     ;;"\\>")                               font-lock-constant-face)
635
     (cons "\\<%\\(end\\|global\\|local\\|m\\(acro\\|end\\)\\)\\>"
636
           font-lock-constant-face)
637

638
     (cons (concat "\\(^[0-9]*\\|;\\|):\\|%then\\|%else\\)[ \t]*"
639
                   "\\(data\\|endsas\\|finish\\|quit\\|run\\|start\\)[ \t\n;]")
640
           font-lock-constant-face)
641
     (cons (concat "\\(^[0-9]*\\|;\\|):\\|%then\\|%else\\)[ \t]*"
642
                   ;;"proc[ \t]+[a-z][a-z_0-9]+")        font-lock-constant-face)
643
                   "proc[ \t]+"
644
                   ;;SAS/Base, SAS/Graph, SAS/FSP and common add-ons
645
                   "\\(append"
646
                   "\\|b\\(genmod\\|lifereg\\|phreg\\)"
647
                   "\\|c\\(a\\(lendar\\|talog\\)\\|port\\|o\\(mpare\\|ntents\\|py\\|rr\\)\\)"
648
                   "\\|d\\(atasets\\|bcstab\\|isplay\\)\\|ex\\(plode\\|port\\)"
649
                   "\\|f\\(orm\\(at\\|s\\)\\|req\\|s\\(browse\\|edit\\|l\\(etter\\|ist\\)\\|view\\)\\)"
650
                   "\\|g?\\(chart\\|p\\(lot\\|rint\\)\\)"
651
                   "\\|g\\(anno\\|contour\\|device\\|font\\|\\(key\\)?map\\|options\\|project"
652
                   "\\|re\\(duce\\|move\\|play\\)\\|slide\\|testit\\|3\\(d\\|grid\\)\\)"
653
                   "\\|\\(map\\|[cg]\\)?import\\|i\\(ml\\|nsight\\)"
654
                   "\\|means\\|options\\|p\\(menu\\|rintto\\)"
655
                   "\\|r\\(ank\\|e\\(gistry\\|port\\)\\)"
656
                   "\\|s\\(ort\\|ql\\|tandard\\|ummary\\)"
657
                   "\\|t\\(abulate\\|emplate\\|imeplot\\|ran\\(spose\\|tab\\)\\)\\|univariate"
658
                   ;;SAS/Stat and SAS/ETS
659
                   "\\|a\\(ceclus\\|nova\\|rima\\|utoreg\\)\\|boxplot"
660
                   "\\|c\\(a\\(lis\\|n\\(corr\\|disc\\)\\|tmod\\)\\|itibase\\|luster\\|o\\(mputab\\|rresp\\)\\)"
661
                   "\\|discrim\\|expand\\|f\\(a\\(ctor\\|stclus\\)\\|orecast\\|req\\)"
662
                   "\\|g\\(enmod\\|l\\(immix\\|m\\(mod\\|power\\|select\\)?\\)\\)\\|inbreed\\|k\\(de\\|rige2d\\)"
663
                   "\\|l\\(attice\\|ife\\(reg\\|test\\)\\|o\\(ess\\|gistic\\)\\)"
664
                   "\\|m\\(ds\\|ixed\\|o\\(de\\(clus\\|l\\)\\|rtgage\\)\\|ulttest\\)"
665
                   "\\|n\\(ested\\|l\\(in\\|mixed\\)\\|par1way\\)\\|orthoreg"
666
                   "\\|p\\(dlreg\\|hreg\\|l\\(an\\|s\\)\\|ower\\|r\\(in\\(comp\\|qual\\)\\|obit\\)\\)\\|r\\(sr\\)?eg"
667
                   "\\|s\\(core\\|im\\(2d\\|lin\\)\\|pectra\\|t\\(atespace\\|dize\\|epdisc\\)\\|urvey\\(means\\|reg\\|select\\)\\|yslin\\)"
668
                   "\\|t\\(phreg\\|pspline\\|r\\(ansreg\\|ee\\)\\|test\\)"
669
                   "\\|var\\(clus\\|comp\\|iogram\\)\\|x11"
670
                   "\\)")        font-lock-constant-face)
671

672
     ;;(cons (concat "\\(^[0-9]*\\|;\\|%then\\|%else\\)[ \t]*"
673
     ;;"\\(%\\(go[ \t]*to\\|i\\(f\\|n\\(clude\\|put\\)\\)\\|let\\|put\\|sysexec\\)\\)"
674
     ;;"\\>")                               font-lock-constant-face)
675
     (cons "\\<%\\(go[ \t]*to\\|i\\(f\\|n\\(clude\\|put\\)\\)\\|let\\|put\\|sysexec\\)\\>"
676
           font-lock-constant-face)
677

678
     (cons "\\<%\\(by\\|else\\|t\\(o\\|hen\\)\\)\\>"
679
           font-lock-constant-face)
680

681
     ;; SAS dataset options/PROC statements followed by an equal sign/left parentheses
682

683
     (cons (concat
684
            "[ \t(,]"
685
            "\\(attrib\\|by\\|compress\\|d\\(ata\\|rop\\)\\|f\\(irstobs\\|ormat\\)"
686
            "\\|i\\(d\\|f\\|n\\)\\|ke\\(ep\\|y\\)\\|l\\(abel\\|ength\\)"
687
            "\\|o\\(bs\\|rder\\|ut\\)\\|rename\\|s\\(ortedby\\|plit\\)"
688
            "\\|var\\|where\\)"
689
            "[ \t]*=")
690
           font-lock-keyword-face)
691
     (cons "\\<\\(in\\(:\\|dex[ \t]*=\\)?\\|until\\|wh\\(en\\|ile\\)\\)[ \t]*("
692
           font-lock-keyword-face)
693

694
     ;; SAS statements
695
     (cons (concat
696
            "\\(^[0-9]*\\|):\\|[;,]\\|then\\|else\\)[ \t]*"
697
            "\\(a\\(bort\\|rray\\|ttrib\\)\\|b\\(ayes\\|y\\)"
698
            "\\|c\\(hange\\|lass\\|ontrast\\)"
699
            "\\|d\\(elete\\|isplay\\|m\\|o\\([ \t]+\\(data\\|over\\)\\)?\\|rop\\)"
700
            "\\|e\\(rror\\|stimate\\|xc\\(hange\\|lude\\)\\)"
701
            "\\|f\\(ile\\(name\\)?\\|o\\(otnote\\(10?\\|[2-9]\\)?\\|rmat\\)\\|req\\)"
702
            "\\|go\\([ \t]*to\\|ptions\\)"
703
            "\\|hazardratio\\|[hv]bar\\(3d\\)?"
704
            "\\|i\\(d\\|f\\|n\\(dex\\|f\\(ile\\|ormat\\)\\|put\\|value\\)\\)"
705
            "\\|keep\\|l\\(abel\\|ength\\|i\\(bname\\|nk\\|st\\)\\|smeans\\)"
706
            "\\|m\\(anova\\|e\\(ans\\|rge\\)\\|issing\\|od\\(el\\|ify\\)\\)\\|note"
707
            "\\|o\\(ds\\|ptions\\|therwise\\|utput\\)\\|p\\(arms\\|lot2?\\|ut\\)"
708
            "\\|r\\(andom\\|e\\(name\\|peated\\|tain\\)\\)"
709
            "\\|s\\(ave\\|e\\(lect\\|t\\)\\|kip\\|trata\\|um\\(by\\)?\\)"
710
            "\\|t\\(ables?\\|i\\(me\\|tle\\(10?\\|[2-9]\\)?\\)\\)\\|update"
711
            "\\|va\\(lue\\|r\\)\\|w\\(eight\\|here\\|i\\(ndow\\|th\\)\\)"
712

713
            ;; IML statements that are not also SAS statements
714
            "\\|append\\|c\\(lose\\(file\\)?\\|reate\\)\\|edit\\|f\\(ind\\|orce\\|ree\\)"
715
            "\\|insert\\|load\\|mattrib\\|p\\(a[ru]se\\|rint\\|urge\\)"
716
            "\\|re\\(move\\|peat\\|place\\|set\\|sume\\)"
717
            "\\|s\\(et\\(in\\|out\\)\\|how\\|ort\\|tore\\|ummary\\)\\|use\\)?"
718

719
            "\\>")                                  font-lock-keyword-face)
720

721

722

723
     ;;  (cons "\\<\\(\\(then\\|else\\)[ \t]*\\)?\\(do\\([ \t]*over\\)?\\|else\\)\\>"
724
     ;;                                             font-lock-keyword-face)
725

726
     ;; SAS statements that must be followed by a semi-colon
727
     (cons (concat
728
            "\\(^[0-9]*\\|):\\|[;,]\\|then\\|else\\)[ \t]*"
729
            "\\(cards4?\\|datalines\\|end\\|l\\(ostcard\\)\\|page\\|return\\|stop\\)?"
730
            "[ \t]*;")                      font-lock-keyword-face)
731

732
     ;; SAS/GRAPH statements not handled above
733
     (cons (concat
734
            "\\(^[0-9]*\\|):\\|[;,]\\)[ \t]*"
735
            "\\(axis\\|legend\\|pattern\\|symbol\\)"
736
            "\\([1-9][0-9]?\\)?\\>")        font-lock-keyword-face)
737

738
     ;; SAS Datastep functions and SAS macro functions
739
                                        ;(cons "%[a-z_][a-z_0-9]*[ \t]*[(;]"
740
     ;; SAS macro functions occasionally defined with no arguments
741
     ;; which means they can be followed by any character that can
742
     ;; separate tokens, however, they are most likely to be followed
743
     ;; by operat-ions/ors
744
     (cons "%[a-z_][a-z_0-9]*[- \t();,+*/=<>]"
745
           font-lock-function-name-face)
746
     (cons "\\<call[ \t]+[a-z_][a-z_0-9]*[ \t]*("
747
           font-lock-function-name-face)
748

749
     (cons (concat
750
            "\\<"
751
            "\\(a\\(bs\\|r\\(cos\\|sin\\)\\|tan\\)\\|b\\(etainv\\|yte\\)"
752
            "\\|c\\(eil\\|inv\\|o\\(llate\\|mpress\\|sh?\\)\\|ss\\|v\\)"
753
            "\\|dacc\\(db\\(\\|sl\\)\\|s\\(l\\|yd\\)\\|tab\\)"
754
            "\\|dep\\(db\\(\\|sl\\)\\|s\\(l\\|yd\\)\\|tab\\)"
755
            "\\|d\\(a\\(te\\(\\|jul\\|part\\|time\\)\\|y\\)\\|hms\\|i\\(f[0-9]*\\|m\\|gamma\\)\\)"
756
            "\\|e\\(rfc?\\|xp\\)"
757
            "\\|f\\(i\\(nv\\|p\\(namel?\\|state\\)\\)\\|loor\\|uzz\\)\\|gam\\(inv\\|ma\\)"
758
            "\\|h\\(bound\\|ms\\|our\\)\\|i\\(n\\(dexc?\\|put\\|t\\(\\|ck\\|nx\\|rr\\)\\)\\|rr\\)"
759
            "\\|juldate\\|kurtosis\\|l\\(ag[0-9]*\\|bound\\|e\\(ft\\|ngth\\)\\|gamma\\|og\\(\\|10\\|2\\)\\)"
760
            "\\|m\\(ax\\|dy\\|ean\\|in\\(\\|ute\\)\\|o\\(d\\|nth\\|rt\\)\\)"
761
            "\\|n\\(\\|etpv\\|miss\\|o\\(rmal\\|t\\)\\|pv\\)"
762
            "\\|prob\\([ft]\\|b\\(eta\\|nml\\)\\|chi\\|gam\\|hypr\\|it\\|n\\(egb\\|orm\\)\\)"
763
            "\\|ordinal\\|p\\(oisson\\|ut\\)\\|qtr\\|r\\(e\\(peat\\|verse\\)\\|ight\\|ound\\)"
764
            "\\|ran\\(bin\\|cau\\|exp\\|g\\(am\\|e\\)\\|k\\|nor\\|poi\\|t\\(bl\\|ri\\)\\|uni\\)"
765
            "\\|s\\(aving\\|can\\|econd\\|i\\(gn\\|nh?\\)\\|qrt\\|t\\(d\\(\\|err\\)\\|fips\\|namel?\\)\\|u\\(bstr\\|m\\)\\|ymget\\)"
766
            "\\|t\\(anh?\\|i\\(me\\(\\|part\\)\\|nv\\)\\|oday\\|r\\(anslate\\|i\\(gamma\\|m\\)\\|unc\\)\\)"
767
            "\\|u\\(niform\\|pcase\\|ss\\)\\|v\\(ar\\|erify\\)"
768
            "\\|weekday\\|y\\(ear\\|yq\\)\\|zip\\(fips\\|namel?\\|state\\)"
769

770
;;;    ;; SAS functions introduced in Technical Report P-222
771

772
            "\\|airy\\|b\\(and\\|lshift\\|not\\|or\\|rshift\\|xor\\)"
773
            "\\|c\\(nonct\\|ompbl\\)\\|d\\(airy\\|equote\\)\\|fnonct\\|tnonct"
774
            "\\|i\\(bessel\\|n\\(dexw\\|put[cn]\\)\\)\\|jbessel\\|put[cn]"
775
            "\\|lowcase\\|quote\\|resolve\\|s\\(oundex\\|ysprod\\)\\|tr\\(anwrd\\|imn\\)"
776

777
;;;    ;; IML functions that are not also Datastep functions
778
            "\\|a\\(ll\\|ny\\|pply\\|rmasim\\)\\|b\\(lock\\|ranks\\|tran\\)"
779
            "\\|c\\(har\\|hoose\\|on\\(cat\\|tents\\|vexit\\|vmod\\)\\|ovlag\\|shape\\|usum\\|vexhull\\)"
780
            "\\|d\\(atasets\\|esignf?\\|et\\|iag\\|o\\|uration\\)"
781
            "\\|e\\(chelon\\|igv\\(al\\|ec\\)\\)\\|f\\(ft\\|orward\\)\\|ginv"
782
            "\\|h\\(alf\\|ankel\\|dir\\|ermite\\|omogen\\)"
783
            "\\|i\\(\\|fft\\|nsert\\|nv\\(updt\\)?\\)\\|j\\(\\|root\\)\\|loc\\|mad"
784
            "\\|n\\(ame\\|col\\|leng\\|row\\|um\\)\\|o\\(pscal\\|rpol\\)"
785
            "\\|p\\(olyroot\\|roduct\\|v\\)\\|r\\(anktie\\|ates\\|atio\\|emove\\|eturn\\|oot\\|owcatc?\\)"
786
            "\\|s\\(etdif\\|hape\\|olve\\|plinev\\|pot\\|qrsym\\|ssq\\|torage\\|weep\\|ymsqr\\)"
787
            "\\|t\\(\\|eigv\\(al\\|ec\\)\\|oeplitz\\|race\\|risolv\\|ype\\)"
788
            "\\|uni\\(on\\|que\\)\\|v\\(alue\\|ecdiag\\)\\|x\\(mult\\|sect\\)\\|yield"
789

790
;;;    ;; SCL functions that are known to work with SAS macro function %sysfunc
791

792
            "\\|attr[cn]\\|c\\(exist\\|lose\\)\\|d\\(close\\|num\\|open\\|read\\)"
793
            "\\|exist\\|f\\(close\\|etchobs\\|i\\(leexist\\|nfo\\)\\|open\\|put\\|write\\)"
794
            "\\|get\\(option\\|var[cn]\\)\\|lib\\(name\\|ref\\)\\|op\\(en\\|t\\(getn\\|setn\\)\\)"
795
            "\\|pathname\\|sysmsg\\|var\\(fmt\\|l\\(abel\\|en\\)\\|n\\(ame\\|um\\)\\|type\\)\\)"
796
            "[ \t]*(")                      font-lock-function-name-face)
797
     ))
798
  "Font Lock regexs for SAS.")
799

800

801
(defvar SAS-editing-alist
802
  '((sentence-end                 . ";[\t\n */]*")
803
    (paragraph-start              . "^[ \t]*$")
804
    (paragraph-separate           . "^[ \t]*$")
805
    (paragraph-ignore-fill-prefix . t)
806
    ;;(fill-paragraph-function      . 'lisp-fill-paragraph)
807
    (adaptive-fill-mode           . nil)
808
    (indent-line-function         . 'sas-indent-line)
809
    ;;(indent-region-function       . 'sas-indent-region)
810
    (require-final-newline        . mode-require-final-newline)
811
    (comment-start                . "/*")
812
    (comment-start-skip           . "/[*]")
813
    (comment-end                  . "*/")
814
    (comment-end-skip             . "[*]/")
815
    (comment-column               . 40)
816
    ;;(comment-indent-function      . 'lisp-comment-indent)
817
    (parse-sexp-ignore-comments   . t)
818
    (ess-style                . ess-default-style)
819
    (ess-local-process-name       . nil)
820
    ;;(ess-keep-dump-files          . 'ask)
821
    (tab-stop-list                . ess-sas-tab-stop-list)
822
    (ess-mode-syntax-table        . SAS-syntax-table)
823
    (font-lock-keywords-case-fold-search . t)
824
    (font-lock-defaults           . '(SAS-mode-font-lock-defaults)))
825
  "General options for editing SAS source files.")
826

827

828
(defun beginning-of-sas-statement (arg &optional comment-start)
829
  "Move point to beginning of current sas statement."
830
  (interactive "P")
831
  (let ((pos (point))
832
        )
833
    (if (search-forward ";" nil 1) (forward-char -1))
834
    (re-search-backward ";[ \n*/]*$" (point-min) 1 arg)
835
    (skip-chars-forward sas-comment-chars)
836
    (if comment-start nil
837
      (if (looking-at "\\*/")
838
          (progn (forward-char 2)
839
                 (skip-chars-forward sas-comment-chars)))
840
      (while (looking-at "/\\*")
841
        (if (not (search-forward "*/" pos t 1)) ;;(;; (point-max) 1 1)
842
            (forward-char 2))
843
        (skip-chars-forward sas-white-chars)))))
844

845
(defun sas-indent-line ()
846
  "Indent function for SAS mode."
847
  (interactive)
848
  (let (indent prev-end
849
               (pos (- (point-max) (point)))
850
               (case-fold-search t)
851
               (cur-ind (current-indentation))
852
               (comment-col (sas-comment-start-col))) ;; 2/1/95 TDC
853
    (save-excursion
854
      (cond ((progn
855
               (back-to-indentation)
856
               (or (bobp)
857
                   (looking-at
858
                    "data[ ;]\\|proc[ ;]\\|run[ ;]\\|quit[ ;]\\|endsas[ ;]\\|g?options[ ;]\\|%macro[ ;]\\|%mend[ ;]")))
859
             ;;  Case where current statement is DATA, PROC, etc...
860
             (setq prev-end (point))
861
             (goto-char (point-min))
862
             ;;  Added 6/27/94
863
             ;;  May get fooled if %MACRO, %DO, etc embedded in comments
864
             (setq indent
865
                   (+ (* (- (sas-how-many "^[ \t]*%macro\\|[ \t]+%do"
866
                                          prev-end)
867
                            (sas-how-many "^[ \t]*%mend\\|%end" prev-end))
868
                         sas-indent-width) comment-col)))  ;; 2/1/95 TDC
869
            ;;  Case where current line begins with sas-indent-ignore-comment
870
            ;; added 6/27/94  to leave "* ;" comments alone.
871
            ((progn
872
               (back-to-indentation)
873
               (and (not (looking-at "*/"))
874
                    (looking-at (concat sas-indent-ignore-comment "\\|/\\*"))))
875
             (setq indent (current-indentation)))
876
            ;;  Case where current statement not DATA, PROC etc...
877
            (t (beginning-of-line 1)
878
               (skip-chars-backward sas-white-chars)
879
               (if (bobp) nil
880
                 (backward-char 1))
881
               (cond
882
                ((looking-at ";")       ;  modified 1/31/95
883
                 (setq indent (sas-next-statement-indentation)))
884
                ((save-excursion;; added 4/28/94 to properly check
885
                   (if (bobp) () (backward-char 1));; for end of comment
886
                   (setq prev-end (point))
887
                   (looking-at "\\*/"));;  improved 1/31/95
888
                 (save-excursion
889
                   (search-backward "*/"
890
                                    (point-min) 1 1); comment start is first /*
891
                   (search-forward "/*"
892
                                   prev-end 1 1)    ; after previous */
893
                   (backward-char 2)                ; 2/1/95 TDC
894
                   (skip-chars-backward sas-white-chars)
895
                   (setq indent
896
                         (if (bobp) 0
897
                           (if (looking-at ";")
898
                               (sas-next-statement-indentation)
899
                             ;;(+ (current-indentation) sas-indent-width)
900
                             (current-indentation))))))
901

902
                ;; added 6/27/94 to leave "* ;" comments alone
903
                ((save-excursion
904
                   (progn
905
                     (beginning-of-sas-statement 1 t)
906
                     (and (not (looking-at "*/"))
907
                          (looking-at sas-indent-ignore-comment))))
908
                 (setq indent cur-ind))
909
                ((progn
910
                   (beginning-of-sas-statement 1)
911
                   (bobp));; added 4/13/94
912
                 (setq indent sas-indent-width));; so the first line works
913
                ((save-excursion
914
                   (beginning-of-sas-statement 2)
915
                   (looking-at "cards4?;\\|datalines4?;\\|lines4?;"))
916
                 (setq indent (current-indentation))) ; So cards keep indentation.
917
                (t
918
                 (if (progn
919
                       (save-excursion
920
                         (beginning-of-line 1)
921
                         (skip-chars-backward sas-white-chars)
922
                         (if (bobp) nil (backward-char 1))
923
                         (or (looking-at ";")
924
                             (bobp) (backward-char 1) (looking-at "\\*/"))))
925
                     (setq indent (+ (current-indentation) sas-indent-width))
926
                   (setq indent (current-indentation))))))))
927
    (save-excursion
928
      (let (beg end)
929
        (back-to-indentation)
930
        (setq end (point))
931
        (beginning-of-line 1)
932
        (setq beg (point))
933
        (delete-region beg end)
934
        (indent-to indent)))
935
    (if (> (- (point-max) pos) (point))
936
        (goto-char (- (point-max) pos)))))
937

938

939
;;(defun sas-indent-region (start end)
940
;;  "Indent a region of SAS code."
941
;;  (interactive "r")
942
;;  (save-excursion
943
;;    (let ((endmark (copy-marker end)))
944
;;      (goto-char start)
945
;;      (and (bolp) (not (eolp))
946
;;         (sas-indent-line))
947
;;      (indent-sexp endmark)
948
;;      (set-marker endmark nil))))
949

950

951
(defun indent-sas-statement (arg)
952
  "Indent all continuation lines sas-indent-width spaces from first
953
line of statement."
954
  (interactive "p")
955
  (let (end)
956
    (save-excursion
957
      (if (> arg 0)
958
          (while (and (> arg 0) (search-forward ";" (point-max) 1 1))
959
            (setq end (point))
960
            (if (bobp) nil (backward-char 1))
961
            (beginning-of-sas-statement 1)
962
            (forward-char 1)
963
            (indent-region (point)
964
                           end
965
                           (+ (current-column) (1- sas-indent-width)))
966
            (search-forward ";" (point-max) 1 1)
967
            (setq arg (1- arg)))))))
968

969
;; added 9/31/94
970
(defun sas-next-statement-indentation ()
971
  "Returns the correct indentation of the next sas statement.
972
The current version assumes that point is at the end of the statement.
973
This will (hopefully) be fixed in later versions."
974
  (if (bobp) 0
975
    (save-excursion
976
      (let ((prev-end (point)))
977
        (beginning-of-sas-statement 1)
978
        (while (and (not (bobp))
979
                    (not (looking-at "*/"))
980
                    (looking-at sas-indent-ignore-comment))
981
          (skip-chars-backward sas-white-chars)
982
          (if (bobp) nil
983
            (backward-char 1))
984
          (setq prev-end (point))
985
          (beginning-of-sas-statement 1 t))
986
        (if (or
987
             (looking-at
988
              (concat "data[ \n\t;]\\|"
989
                      (regexp-opt '("cards;" "cards4;" "datalines;" "datalines4;" "lines;" "lines4;"))
990
                      "\\|proc[ \n\t]\\|%?do[ \n\t;]\\|%macro[ \n\t]\\|/\\*"))
991
             (save-excursion
992
               (re-search-forward
993
                "\\b%?then\\>[ \n\t]*\\b%?do\\>\\|\\b%?else\\>[ \n\t]*\\b%?do\\>"
994
                prev-end 1 1))) ; fixed 1/30/95 to avoid being fooled by
995
                                        ; variable names starting with "do"
996
            (+ (current-indentation) sas-indent-width)
997
          (if (looking-at "%?end[ ;\n]\\|%mend[ ;\n]\\|\\*/")
998
              (max (- (current-indentation) sas-indent-width) 0)
999
            (current-indentation)))))))
1000

1001
;; added 2/1/95
1002
(defun sas-comment-start-col ()
1003
  "If the current line is inside a /* */ comment, returns column in which the
1004
opening /* appears.  returns 0 otherwise."
1005
  (let ((pos (point)))
1006
    (save-excursion
1007
      (if (and (search-backward "*/" (point-min) 1 1)
1008
               (search-forward "/*" pos 1 1))
1009
          (current-indentation)
1010
        0))))
1011

1012

1013
;;  Created 6/27/94 to verify that RUN; statements match PROC and DATA
1014
;;  statements.  Useful since indentation my be goofy w/o "RUN;"
1015
(defun sas-check-run-statements ()
1016
  "Check to see that \"run\" statements are matched with proc, data statements."
1017
  (interactive)
1018
  (let (pos
1019
        (ok t)
1020
        (eob-ok t))
1021
    (save-excursion
1022
      (beginning-of-line)
1023
      (while ok
1024
        (if (re-search-forward
1025
             "\\(^[ \t]*run[ ;]\\)\\|\\(^[ \t]*proc \\|^[ \t]*data[ ;]\\)"
1026
             nil 1)
1027
            (if (match-beginning 2)
1028
                (if (re-search-forward
1029
                     "\\(^[ \t]*run[ ;]\\)\\|\\(^[ \t]*proc \\|^[ \t]*data[ ;]\\)"
1030
                     nil t)
1031
                    (progn (setq pos (point))
1032
                           (setq ok (match-beginning 1)))
1033
                  (setq eob-ok nil pos (point-max))))
1034
          (setq ok nil)))
1035
      (setq ok (eobp)))
1036
    (if (and ok eob-ok) (message "Run statements match")
1037
      (goto-char pos)
1038
      (beep)
1039
      (message "Missing Run Statement."))))
1040

1041
(defun sas-fix-life-tables ()
1042
  "Remove censored and duplicate observations from life tables generated by
1043
Proc Lifetest.  Operates on current region.  A major space saver if there is
1044
heavy censoring."
1045
  (interactive)
1046
  (if buffer-read-only (setq buffer-read-only nil))
1047
  (goto-char (point-min))
1048
  (while (re-search-forward "^.*[ ]+[.][ ]+[.][ ]+[.][ ]+.*$" nil t)
1049
    (replace-match "" nil nil)))
1050
                                        ;  (save-excursion
1051
                                        ;    (shell-command-on-region
1052
                                        ;     start end
1053
                                        ;     "sed '/[ ][.][ ]/d'" t)))
1054
;;"sed \"\\?          *\\.          *\\.          *\\.    ?d\"" t)))
1055
;;(vip-goto-line 1)
1056
;;(setq ex-g-flag nil
1057
;;ex-g-variant nil)
1058
;;(vip-ex "1,$g/           \\.           \\.           \\.    /d")))
1059

1060
(defun sas-fix-page-numbers (offset &optional page-num)
1061
  "Fix number of current page in sas output files after editing.  Add
1062
OFFSET to actual page number."
1063
  (interactive "P")
1064
  (if (not offset) (setq offset 0))
1065
  (if (not page-num) (setq page-num (sas-page-number)))
1066
  (save-excursion
1067
    (if (/= (preceding-char) ?\C-l) (backward-page 1))
1068
    (let (end len mstart mend)
1069
      (save-excursion
1070
        (forward-line sas-page-number-max-line)
1071
        (setq end (point)))
1072
      (if (re-search-forward
1073
           "\\(^[0-9]+[ ]\\)\\|\\([ ][0-9]+$\\)"
1074
           end t)
1075
          (progn (setq len (- (match-end 0) (match-beginning 0))
1076
                       mstart (match-beginning 0)
1077
                       mend (match-end 0))
1078
                 (delete-region mstart mend)
1079
                 (if (eolp)
1080
                     (insert (format
1081
                              (concat "%" len "d") (+ page-num offset)))
1082
                   (insert (substring
1083
                            (concat (+ (sas-page-number) offset) "      ")
1084
                            0 len))))))))
1085

1086
(defun sas-page-fix (start)
1087
  "Fix page numbers in sas output from point to end of file.
1088
If START is given this will be the number for the current page."
1089
  (interactive "P")
1090
  (let (offset (pnum (sas-page-number)))
1091
    (if (not start) (setq offset 0)
1092
      (setq offset (- start pnum)))
1093
    (while (not (eobp))
1094
      (sas-fix-page-numbers offset pnum)
1095
      (setq pnum (1+ pnum))
1096
      (forward-page 1))))
1097

1098
(defun fix-page-breaks ()
1099
  "Fix page breaks in SAS 6 print files."
1100
  (interactive)
1101
  (save-excursion
1102
    (goto-char (point-min))
1103
    (if (looking-at "\f") (delete-char 1))
1104
                                        ;(replace-regexp "^\\(.+\\)\f" "\\1\n\f\n")
1105
    (while (re-search-forward "^\\(.+\\)\f" nil t)
1106
      (replace-match "\\1\n\f\n" nil nil))
1107
    (goto-char (point-min))
1108
                                        ;(replace-regexp "^\f\\(.+\\)" "\f\n\\1")
1109
    (while (re-search-forward "^\f\\(.+\\)" nil t)
1110
      (replace-match "\f\n\\1" nil nil))
1111
                                        ;    (goto-char (point-min))
1112
                                        ;(replace-regexp " $" "")
1113
                                        ;(while (re-search-forward "$" nil t)
1114
                                        ;     (replace-match "" nil nil))
1115
    (goto-char (point-min))
1116
                                        ;(replace-regexp " \\([^\\$]+\\)" "\n\\1")
1117
    (while (re-search-forward " \\([^\\$]+\\)" nil t)
1118
      (replace-match "\n\\1" nil nil))
1119
    (goto-char (point-max))
1120
    (if (not (bobp))
1121
        (progn (backward-char 1)
1122
               (if (not (looking-at "\n"))
1123
                   (progn (forward-char 1) (open-line 1)))))))
1124

1125
(defun sas-page-number ()
1126
  ;; like what-page except it returns an integer page number
1127
  "Return page number of point in current buffer."
1128
  (let ((opoint (point))) (save-excursion
1129
                            (goto-char (point-min))
1130
                            (1+ (sas-how-many page-delimiter opoint)))))
1131

1132
(defun sas-how-many (regexp &optional end)
1133
  ;; a copy of `how-many' which returns an integer
1134
  ;; rather than a message
1135
  "Return number of matches for REGEXP following point."
1136
  (let ((count 0) opoint)
1137
    (save-excursion
1138
      (while (and (not (eobp))
1139
                  (progn (setq opoint (point))
1140
                         (re-search-forward regexp end t)))
1141
        (if (= opoint (point))
1142
            (forward-char 1)
1143
          (setq count (1+ count))))
1144
      count)))
1145

1146
(defun beginning-of-sas-proc ()
1147
  "Move point to beginning of sas proc, macro or data step."
1148
  (interactive)
1149
  (let ((case-fold-search t))
1150
    (forward-char -1)
1151
    (while (not (or (looking-at "data\\|proc\\|%macro")
1152
                    (bobp)))
1153
      (re-search-backward "proc\\|data\\|%macro" (point-min) 1)
1154
      (beginning-of-sas-statement 1))))
1155

1156
(defun next-sas-proc (arg)
1157
  "Move point to beginning of next sas proc."
1158
  (interactive "P")
1159
  (let ((case-fold-search t))
1160
    (forward-char 1)
1161
    (if (re-search-forward
1162
         "^[ \t]*\\(data[ ;]\\|proc[ ;]\\|endsas[ ;]\\|g?options[ ;]\\|%macro[ ;]\\)"
1163
         nil t arg)
1164
        (beginning-of-sas-statement 1)
1165
      (forward-char -1))))
1166

1167
(defun set-sas-file-name ()
1168
  "Stores the name of the current sas file."
1169
  (let ((name (buffer-file-name)))
1170
    (cond ((not name))
1171
          ((string-match (substring name -4 nil)
1172
                         "\\.sas\\|\\.lst\\|\\.log")
1173

1174
           (setq sas-file-name (substring name 0 (- (length name) 4)))
1175
           (setq sas-buffer-name (buffer-name))
1176
           (setq sas-file-root (substring sas-buffer-name 0
1177
                                          (- (length sas-buffer-name) 4))))
1178
          (t (message "This file does not have a standard suffix")))))
1179

1180
;;  created 6/27/94
1181
(defun sas-set-alternate-file-name (name)
1182
  "Stores the NAME of an alternate sas file.
1183
When this file is submitted with `submit-sas', the alternate file will
1184
be submitted instead.  `sas-submitable' is automatically sets to t."
1185
  (interactive "f")
1186
  (cond ((string-match (substring name -4 nil)
1187
                       "\\.sas\\|\\.lst\\|\\.log")
1188
         (setq sas-file-name (substring name 0 (- (length name) 4)))
1189
         (setq sas-submitable t))
1190
        (t (message "This file does not have a standard suffix"))))
1191

1192
(defun switch-to-sas-source ()
1193
  "Switches to sas source file associated with the current file."
1194
  (interactive)
1195
  (switch-to-sas-file "sas"))
1196

1197
(defun switch-to-sas-lst ()
1198
  "Switches to sas source file associated with the current file."
1199
  (interactive)
1200
  (switch-to-sas-file "lst"))
1201

1202
(defun switch-to-sas-log ()
1203
  "Switches to sas source file associated with the current file."
1204
  (interactive)
1205
  (switch-to-sas-file "log"))
1206

1207
(defun switch-to-sas-source-other-window ()
1208
  "Switches to sas source file associated with the current file."
1209
  (interactive)
1210
  (switch-to-sas-file-other-window "sas"))
1211

1212
(defun switch-to-sas-lst-other-window ()
1213
  "Switches to sas source file associated with the current file."
1214
  (interactive)
1215
  (switch-to-sas-file-other-window "lst"))
1216

1217
(defun switch-to-sas-log-other-window ()
1218
  "Switches to sas source file associated with the current file."
1219
  (interactive)
1220
  (switch-to-sas-file-other-window "log"))
1221

1222
;;(defun switch-to-sas-file (suff &optional revert silent)
1223
;;  "Switches to sas \"SUFF\" file associated with the current file"
1224
;;  (let* ((sfile sas-file-name)
1225
;;       (buf (get-file-buffer (concat sfile "." suff)))
1226
;;       (sas-require-confirmation
1227
;;           (and sas-require-confirmation (not revert))))
1228
;;     (if (or sas-require-confirmation (string-equal suff "sas") (not buf))
1229
;;         (find-file (concat sfile "." suff))
1230
;;       (progn (switch-to-buffer buf)
1231
;;              (if (not (verify-visited-file-modtime (current-buffer)))
1232
;;                  (progn (revert-buffer t t)
1233
;;                         (if (not silent)
1234
;;                             (message "File has changed on disk.  Buffer automatically updated."))))))
1235
;;     (setq sas-file-name sfile))
1236
;;   (if (string-equal suff "sas")
1237
;;       (if (not (string-equal major-mode "sas-mode"))
1238
;;           (sas-mode))
1239
;;     (if (not (string-equal major-mode "sasl-mode"))
1240
;;         (sasl-mode))))
1241
;;
1242
;;(defun switch-to-sas-file-other-window (suff)
1243
;;  "Switches to sas \"SUFF\" file associated with the current file"
1244
;;  (let* ((sfile sas-file-name)
1245
;;       (buf (get-file-buffer (concat sfile "." suff))))
1246
;;    (if (or sas-require-confirmation (string-equal suff "sas") (not buf))
1247
;;      (find-file-other-window (concat sfile "." suff))
1248
;;      (progn (switch-to-buffer-other-window buf)
1249
;;           (if (not (verify-visited-file-modtime (current-buffer)))
1250
;;               (progn (revert-buffer t t)
1251
;;                      (message "File has changed on disk.  Buffer automatically updated.")))))
1252
;;    (setq sas-file-name sfile))
1253
;;  (if (string-equal suff "sas")
1254
;;      (if (not (string-equal major-mode "sas-mode"))
1255
;;        ;;(sas-mode)
1256
;;        )
1257
;;    (if (not (string-equal major-mode "sasl-mode"))
1258
;;      ;;(sasl-mode)
1259
;;      )))
1260

1261
(defun switch-to-sas-file (suff)
1262
  "Switches to sas \"SUFF\" file associated with the current file."
1263
  (switch-to-buffer (set-sas-file-buffer suff)))
1264

1265
(defun switch-to-sas-file-other-window (suff)
1266
  "Switches to sas \"SUFF\" file associated with the current file."
1267
  (switch-to-buffer-other-window (set-sas-file-buffer suff)))
1268

1269
;;  The following was created 6/7/94 to handle buffers without messing up
1270
;;  windows.
1271

1272
(defun set-sas-file-buffer (suff &optional revert silent)
1273
  "Sets current buffer to sas \"SUFF\" file associated with the current file."
1274
  (let* ((sfile sas-file-name)
1275
         (buf (get-file-buffer (concat sfile "." suff)))
1276
         (sas-require-confirmation
1277
          (and sas-require-confirmation (not revert))))
1278
    (if (or sas-require-confirmation (string-equal suff "sas") (not buf))
1279
        (set-buffer (find-file-noselect (concat sfile "." suff)))
1280
      (progn (set-buffer buf)
1281
             (if (not (verify-visited-file-modtime (current-buffer)))
1282
                 (progn (revert-buffer t t)
1283
                        (if (not silent)
1284
                            (message "File has changed on disk.  Buffer automatically updated."))))))
1285
    (setq sas-file-name sfile))
1286
  ;;(if (string-equal suff "sas")
1287
  ;; (if (not (string-equal major-mode "sas-mode")) (sas-mode))
1288
  ;; (if (not (string-equal major-mode "sasl-mode"))(sasl-mode))
1289
  (current-buffer))
1290

1291
(defun switch-to-sas-process-buffer ()
1292
  "Switch to sas-process-buffer."
1293
  (interactive)
1294
  (let (buf proc-name)
1295
    (setq proc-name (concat "SAS" sas-file-name)
1296
          buf (concat "*" proc-name "*"))
1297
    (switch-to-buffer-other-window buf)))
1298

1299
(defun submit-sas ()
1300
  ;; 6/17/94  added sas-submitable local variable.
1301
  "Submit SAS file as shell command."
1302
  (interactive)
1303
  (if ;; can file be run, or is it only for inclusion?
1304
      (or sas-submitable
1305
          (progn
1306
            (beep)
1307
            (y-or-n-p
1308
             (format
1309
              "Submission is disabled for this file.  Submit it anyway? "))))
1310
      (progn
1311
        ;; if buffer name has changed, tell user
1312
        (if (or
1313
             (string-equal sas-buffer-name (buffer-name))
1314
             (not
1315
              (y-or-n-p
1316
               (format
1317
                "The name of this buffer has changed.  Submit the new file? "))))
1318
            (setq sas-buffer-name (buffer-name))
1319
          (set-sas-file-name))
1320
        (let ((sas-file sas-file-name)
1321
              (sas-root sas-file-root)
1322
              ;;(sas-buf  sas-buffer-name)
1323
              proc-name
1324
              buf)
1325

1326
          ;; Save buffer to SAS the right file :-).
1327
          (if (buffer-modified-p)
1328
              (if (y-or-n-p (format "Buffer %s is modified. Save it? "
1329
                                    (buffer-name)))
1330
                  (save-buffer)))
1331
          (setq proc-name (concat "SAS" sas-file)
1332
                buf (concat "*" proc-name "*"))
1333
          (if (get-buffer buf)
1334
              (save-window-excursion (switch-to-buffer buf)
1335
                                     (erase-buffer)
1336
                                     (setq default-directory
1337
                                           (file-name-directory sas-file))))
1338

1339
          (run-hooks 'sas-pre-run-hook)  ;; added 8/24/94
1340
          (message "----  Submitting SAS job   ----")
1341
          ;; (switch-to-buffer buf)
1342
          (make-comint proc-name
1343
                       sas-program     ;added sas-program 4/29/94
1344
                       nil
1345
                       sas-root)
1346
          (save-window-excursion
1347
            (switch-to-buffer buf)
1348
            (setq sas-file-name sas-file)
1349
            (bury-buffer buf))
1350

1351
          (message "----  SAS job submitted  ----   ")
1352

1353
          (if sas-notify;;  added 4/7/94
1354
              (set-process-sentinel (get-process proc-name) 'sas-sentinel)
1355
            (display-buffer buf t))))
1356
    (message "----  File not submitted  ----")))
1357

1358
;; 5/2/94 Modified sas-sentinel to check for errors in log file upon
1359
;; completion.
1360
(defun sas-sentinel (proc arg);; created 4/7/94
1361
  "Notify user that SAS run is done."
1362
  (beep)
1363
  ;;(if (string-equal arg "finished\n")
1364
  (save-excursion
1365
    (let (msg buf win (sbuf (concat "*" (process-name proc) "*")))
1366
      (setq msg
1367
            (format "SAS %s %s"
1368
                    (substring arg 0 -1)
1369
                    (if sas-error-notify
1370
                        ;;(save-window-excursion
1371
                        (progn
1372
                          (set-buffer sbuf)
1373
                          (setq buf (set-sas-file-buffer "log" t t))
1374
                          (goto-char (point-min))
1375
                          (setq win (get-buffer-window buf))
1376
                          (save-window-excursion
1377
                            (if win
1378
                                (progn
1379
                                  (select-window win)
1380
                                  (if (re-search-forward "^ERROR" nil t)
1381
                                      " (See .log file for errors)"
1382
                                    ""))
1383
                              (switch-to-buffer buf)
1384
                              (if (re-search-forward "^ERROR" nil t)
1385
                                  " (See .log file for errors)"
1386
                                ""))))
1387
                      "")))
1388
      (set-buffer sbuf)
1389
      (goto-char (point-max))
1390
      (insert msg)
1391
      (bury-buffer (get-buffer sbuf))
1392
      ;;(if (and sas-notify-popup window-system)
1393
      ;;    (x-popup-dialog t
1394
      ;;                (list "SAS Menu" (cons msg  nil) )))
1395
      ;;(if (not (minibuffer-window-active-p)) (princ msg))
1396
      (princ msg))))
1397

1398
;; 5/2/94 Modified run-sas-on-region to separate log and output buffers.
1399
;;
1400
;;(defun run-sas-on-region (start end append &optional buffer)
1401
;;  "Submit region to SAS"
1402
;;  (interactive "r\nP")
1403
;;  (message "----  Running SAS  ----")
1404
;;  (let ((sfile sas-file-name)
1405
;;        (shell-file-name "/bin/sh")
1406
;;        serror buff)
1407
;;    (setq buffer (or buffer "*SAS output*"))
1408
;;    (save-excursion
1409
;;      (shell-command-on-region
1410
;;       start end;; added sas-program
1411
;;       (concat sas-program " -nonews -stdio 2> /tmp/_temp_.log" nil))
1412
;;      (get-buffer-create "*SAS Log*")
1413
;;      (save-window-excursion
1414
;;        (switch-to-buffer "*SAS Log*")
1415
;;        (erase-buffer)
1416
;;        (insert-file-contents "/tmp/_temp_.log")
1417
;;        (delete-file "/tmp/_temp_.log")
1418
;;        (setq serror (re-search-forward "^ERROR" nil t))
1419
;;        (if serror () (bury-buffer)))
1420
;;      (setq buff (get-buffer-create buffer))
1421
;;      (save-window-excursion
1422
;;        (switch-to-buffer buff)
1423
;;        (setq sas-file-name sfile)
1424
;;        (if append
1425
;;            (progn
1426
;;              (end-of-buffer)
1427
;;              (insert "\f\n"))
1428
;;          (erase-buffer))
1429
;;        (if (get-buffer "*Shell Command Output*")
1430
;;            (progn (insert-buffer "*Shell Command Output*")
1431
;;                   (kill-buffer "*Shell Command Output*"))
1432
;;          (insert "SAS completed with no output."))
1433
;;        (if append () (sasl-mode))
1434
;;        (message "----  SAS Complete ----")))
1435
;;    (if (not serror)
1436
;;        (switch-to-buffer-other-window  buff)
1437
;;      (switch-to-buffer-other-window "*SAS Log*")
1438
;;      (goto-char serror)
1439
;;      (beep)
1440
;;      (message "Error found in log file.")
1441
;;      )))
1442

1443
(defun switch-to-dataset-log-buffer ()
1444
  "Switch to log buffer for run-sas-on-region."
1445
  (interactive)
1446
  (switch-to-buffer-other-window "*SAS Log*"))
1447

1448
(defun switch-to-dataset-source-buffer ()
1449
  "Switch to source buffer for run-sas-on-region."
1450
  (interactive)
1451
  (switch-to-buffer-other-window (format " *sas-tmp-%s*" sas-dataset)))
1452

1453
;;(defun sas-get-dataset (filename &optional arg opts-p append buffer vars)
1454
;;  "Run proc contents and proc print on SAS dataset.  Automatically prompts
1455
;;for SAS options to use.  Default options are defined by the variable
1456
;;`sas-get-options'.  Output may be updated from within output buffer with
1457
;;C-cr if dataset changes.  Also, the source code which generates the output
1458
;;may be edited with C-cs.  Typing C-cr within the output buffer reexecutes
1459
;;the (modified) source code."
1460
;;  (interactive "fName of SAS dataset (file name):")
1461
;;  (let ((file (file-name-nondirectory filename))
1462
;;        (dir (file-name-directory filename))
1463
;;        (opts sas-get-options)
1464
;;        (minibuffer-history sas-get-options-history)
1465
;;        buf); fsize)
1466
;;    (setq buffer (or buffer (concat "*" file "*")))
1467
;;    (setq opts (if opts-p opts (read-string "SAS options: " opts)))
1468
;;    (setq sas-get-options-history minibuffer-history)
1469
;;    (cond ((string-match (substring file -6 nil) "\\.ssd01")
1470
;;      (setq file (substring file 0 (- (length file) 6))))
1471
;;    (t (error "This file is not a SAS dataset.")))
1472
;;    (setq buf (format " *sas-tmp-%s*" file))
1473
;;    (get-buffer-create buf)
1474
;;    (save-window-excursion
1475
;;      (switch-to-buffer buf)
1476
;;      (erase-buffer)
1477
;;      (setq default-directory dir)
1478
;;      (if opts
1479
;;          (insert (format "options  %s ;\n" opts)))
1480
;;      (insert (format "title \"Contents of SAS dataset `%s'\" ;\n" file))
1481
;;      (insert (format "libname %s '%s' ;\n" sas-tmp-libname dir))
1482
;;      (if (not (equal arg 1))
1483
;;               (insert (format "proc contents data = %s.%s ;\n" sas-tmp-libname file)))
1484
;;      (if (equal arg 2) ()
1485
;;        (insert (format "proc print data = %s.%s ;\n" sas-tmp-libname file))
1486
;;        (if vars (insert (format "  var %s ;\n" vars))))
1487
;;      (run-sas-on-region (point-min) (point-max) append
1488
;;                         buffer)
1489
;;      (get-buffer buffer)
1490
;;      (if append () (sasd-mode))  ;; added 5/5/94
1491
;;      (setq sas-dataset file))
1492
;;    (if (get-buffer-window buffer t)
1493
;;        (raise-frame (window-frame (get-buffer-window buffer t)))
1494
;;    (display-buffer buffer (not append)))
1495
;;    ))
1496

1497
;;(defun revert-sas-dataset ()
1498
;;  "Revert current sas dataset from disk version"
1499
;;  (interactive)
1500
;;  (let* ((file sas-dataset)
1501
;;        (buf (format " *sas-tmp-%s*" file))
1502
;;        (pos (point)))
1503
;;      (save-window-excursion
1504
;;        (switch-to-buffer buf)
1505
;;        (run-sas-on-region (point-min) (point-max) nil
1506
;;                           (concat "*" file ".ssd01*"))
1507
;;        )
1508
;;      (goto-char pos)  ;; added 6/9/94
1509
;;    (sasd-mode)  ;; added 5/5/94
1510
;;    (setq sas-dataset file)))
1511

1512
(defun sas-insert-local-variables ()  ;; created 6/17/94
1513
  "Add local variables code to end of sas source file."
1514
  (interactive)
1515
  (save-excursion
1516
    (if (re-search-forward "* *Local Variables: *;" nil t)
1517
        ()
1518
      (goto-char (point-max))
1519
      (insert "
1520

1521
**  Local Variables:  ;
1522
**  End:  ;
1523
page ;
1524
"))))
1525

1526

1527

1528
;;-*-emacs-lisp-*-
1529
;;;  file name: sas-data.el
1530
;;;
1531
;;;  Version 1.0
1532
;;;
1533
;;;    sas-data-mode:  manage sas datasets
1534
;;;    Copyright (C) 1994 Tom Cook
1535
;;;
1536
;;;    This program is free software; you can redistribute it and/or modify
1537
;;;    it under the terms of the GNU General Public License as published by
1538
;;;    the Free Software Foundation; either version 2 of the License, or
1539
;;;    (at your option) any later version.
1540
;;;
1541
;;;    This program is distributed in the hope that it will be useful,
1542
;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
1543
;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
1544
;;;    GNU General Public License for more details.
1545
;;;
1546
;;; A copy of the GNU General Public License is available at
1547
;;; http://www.r-project.org/Licenses/
1548
;;;
1549
;;;  Author:   Tom Cook
1550
;;;            Dept. of Biostatistics
1551
;;;            University of Wisconsin - Madison
1552
;;;            Madison, WI 53706
1553
;;;            [email protected]
1554
;;   Created: 8/11/94
1555

1556
;;  variables section
1557
(defvar sas-dir-mode-map nil)
1558
(defvar sas-directory-name nil
1559
  "Name of directory associated with this buffer.")
1560
(make-variable-buffer-local 'sas-directory-name)
1561
(defvar sas-dir-buf-end nil)
1562
(make-variable-buffer-local 'sas-dir-buf-end)
1563
(defvar sas-sorted-by-num nil)
1564
(make-variable-buffer-local 'sas-sorted-by-num)
1565
;; user variables
1566

1567
;; keymaps etc...
1568

1569
(if sas-dir-mode-map ()
1570
  (setq sas-dir-mode-map (make-sparse-keymap))
1571
  ;;(define-key sas-dir-mode-map "c" 'sas-contents)
1572
  (define-key sas-dir-mode-map "p" 'sas-print)
1573
  (define-key sas-dir-mode-map "m" 'sas-mark-item)
1574
  (define-key sas-dir-mode-map "u" 'sas-unmark-item)
1575
  (define-key sas-dir-mode-map " " 'sas-next-line)
1576
  (define-key sas-dir-mode-map "\C-n" 'sas-next-line)
1577
  (define-key sas-dir-mode-map "\C-p" 'sas-prev-line)
1578
  (define-key sas-dir-mode-map "\177" 'sas-prev-line-undo)
1579
  (define-key sas-dir-mode-map "\C-b" 'sas-backward-page-narrow)
1580
  (define-key sas-dir-mode-map "\C-v" 'sas-forward-page-narrow)
1581
  (define-key sas-dir-mode-map "\C-m" 'sas-goto-dataset)
1582
  (define-key sas-dir-mode-map [mouse-2] 'sas-mouse-goto-dataset)
1583
  (define-key sas-dir-mode-map "t" 'sas-dir-goto-page)
1584
  (define-key sas-dir-mode-map "q" 'bury-buffer)
1585
  (define-key sas-dir-mode-map "g" 'sas-revert-library)
1586
  (define-key sas-dir-mode-map "1" 'digit-argument)
1587
  (define-key sas-dir-mode-map "2" 'digit-argument)
1588
  (define-key sas-dir-mode-map "3" 'digit-argument)
1589
  (define-key sas-dir-mode-map "4" 'digit-argument)
1590
  (define-key sas-dir-mode-map "5" 'digit-argument)
1591
  (define-key sas-dir-mode-map "6" 'digit-argument)
1592
  (define-key sas-dir-mode-map "7" 'digit-argument)
1593
  (define-key sas-dir-mode-map "8" 'digit-argument)
1594
  (define-key sas-dir-mode-map "9" 'digit-argument)
1595
  (define-key sas-dir-mode-map [menu-bar sas run]
1596
    '("Submit File " . submit-sas))
1597
  )
1598

1599
                                        ;(require 'sas)
1600

1601
(defun sas-dir-mode ()
1602
  "Major mode for managing sas files."
1603
  (interactive)
1604
  (kill-all-local-variables)
1605
  (use-local-map sas-dir-mode-map)
1606
  (setq major-mode 'sas-dir-mode)
1607
  (setq mode-name "SAS")
1608
  (setq sas-directory-name (expand-file-name default-directory))
1609
  (setq buffer-read-only 1))
1610

1611

1612
;;(defun sas-make-library (directory &optional update)
1613
;;  "Create a buffer with the names of all sas datasets from DIRECTORY."
1614
;;  (interactive "DDirectory Name: ")
1615
;;  (let ((dir (expand-file-name directory)) buf out cont pos)
1616
;;    (setq buf (format " *sas-tmp-%s*" dir))
1617
;;    (setq out (concat "*SAS-dir-" dir))
1618
;;    (setq cont (concat "*SAS-cont-" dir))
1619
;;    (get-buffer-create buf)
1620
;;    (if (get-buffer out)
1621
;;        (if update
1622
;;            (progn
1623
;;              (set-buffer out)
1624
;;              (setq buffer-read-only nil)))
1625
;;      (setq update t))
1626
;;    (pop-to-buffer out)
1627
;;    (setq default-directory dir)
1628
;;    (setq pos (point))
1629
;;    (if update
1630
;;        (progn
1631
;;          (save-window-excursion
1632
;;            (set-buffer buf)
1633
;;            (erase-buffer)
1634
;;            (setq default-directory dir)
1635
;;            (insert "options linesize=70 pagesize=1000 ;\n")
1636
;;            (insert (format "title \"Contents of SAS directory `%s'\" ;\n"
1637
;;                            dir))
1638
;;            (insert (format "libname %s '%s' ;\n" sas-tmp-libname dir))
1639
;;            (insert (format "proc contents data = %s._all_ directory details memtype=data ;\n" sas-tmp-libname))
1640
;;            (run-sas-on-region (point-min) (point-max) nil
1641
;;                               out)
1642
;;            (set-buffer out)
1643
;;            (goto-char (point-min))
1644
;;            (if (= (sas-how-many page-delimiter (point-max)) 0)
1645
;;                (let ((buffer-read-only nil))
1646
;;                  (erase-buffer)
1647
;;                  (insert "There are no SAS datasets in this directory")
1648
;;                  (pop-to-buffer out))
1649
;;              (save-excursion
1650
;;                (set-buffer (get-buffer-create cont))
1651
;;                (setq buffer-read-only t)
1652
;;                (let ((buffer-read-only nil))
1653
;;                  (erase-buffer)
1654
;;                  (insert-buffer out)
1655
;;                  (delete-region (point-min)
1656
;;                                 (or (re-search-forward page-delimiter nil t)
1657
;;                                     (point-min)))
1658
;;                  (sas-page-fix 1)
1659
;;                  (goto-char (point-min))
1660
;;                  (sas-dir-mode)
1661
;;                  (sas-narrow-to-page)))
1662
;;              (if (re-search-forward page-delimiter nil t)
1663
;;                  (delete-region (progn (beginning-of-line) (point))
1664
;;                                 (point-max)))
1665
;;              (sas-insert-set-properties (point-min) (point-max))
1666
;;              )
1667
;;            (switch-to-buffer out t)
1668
;;            (goto-char (point-min))
1669
;;            (sas-dir-mode)
1670
;;            (setq sas-dir-buf-end (point-max)))
1671
;;          (goto-char pos)
1672
;;          (sas-move-to-filename (point-max))))))
1673

1674

1675
(defun sas-move-to-filename (&optional eol)
1676
  (or eol (setq eol (progn (end-of-line) (point))))
1677
  (beginning-of-line)
1678
  (if (re-search-forward "\\(^ *[0-9]+ *<*\\)[^:0-9\n]" eol t)
1679
      (goto-char (match-end 1))))
1680

1681
(defun sas-next-line (arg)
1682
  "Move down one line."
1683
  (interactive "p")
1684
  (forward-line arg)
1685
  (sas-move-to-filename (point-max)))
1686
;;(and (< (point) sas-dir-buf-end)
1687
;;(forward-line arg)
1688
;;(sas-move-to-filename sas-dir-buf-end)))
1689

1690
(defun sas-prev-line (arg)
1691
  "Move up one line."
1692
  (interactive "p")
1693
  (beginning-of-line)
1694
  (re-search-backward "^ *[0-9]+ *<*[^:0-9\n]" (point-min) t)
1695
  (sas-move-to-filename sas-dir-buf-end))
1696

1697
(defun sas-insert-set-properties (beg end)
1698
  (save-excursion
1699
    (goto-char beg)
1700
    (while (< (point) end)
1701
      (if (sas-move-to-filename)
1702
          (put-text-property (point)
1703
                             (+ 8 (point))
1704
                             'mouse-face 'highlight))
1705
      (forward-line 1))))
1706

1707
(defun sas-get-filename ()
1708
  "Return name of dataset on current line."
1709
  (interactive)
1710
  (save-excursion
1711
    (if (string-equal "*SAS-dir" (substring (buffer-name) 0 8))
1712
        (sas-move-to-filename)
1713
      (goto-char (point-min))
1714
      (re-search-forward "Data Set Name: [^.]*\\."))
1715
    (expand-file-name
1716
     (downcase (concat sas-directory-name
1717
                       (buffer-substring
1718
                        (point)
1719
                        (save-excursion
1720
                          (skip-chars-forward "A-Z0-9_")
1721
                          (point))) ".ssd01")))))
1722

1723
(defun sas-get-file-number ()
1724
  "Return name of dataset on current line."
1725
  (interactive)
1726
  (if (sas-move-to-filename)
1727
      (progn (forward-word -1)
1728
             (re-search-forward "[0-9]*")
1729
             (string-to-number
1730
              (buffer-substring (match-beginning 0)
1731
                                (match-end 0))))))
1732

1733
;;(defun sas-contents ()
1734
;;  "Run proc contents on current file."
1735
;;  (interactive)
1736
;;  (let ((buffer-read-only nil) (sas-get-options "linesize=70"))
1737
;;    (sas-get-dataset (sas-get-filename) 2 t t (buffer-name))
1738
;;    (end-of-buffer)
1739
;;    (backward-page-top-of-window 1)))
1740
;;
1741
;;(defun sas-print ()
1742
;;  "Run proc contents on current file."
1743
;;  (interactive)
1744
;;  (sas-get-dataset (sas-get-filename) 1 nil nil nil
1745
;;                   (sas-create-var-string)))
1746

1747
(defun sas-goto-page (arg)
1748
  "Goto top of page ARG.  If no ARG, then goto top of file."
1749
  (interactive "P")
1750
  (goto-char 1)
1751
  (if arg
1752
      (if (> arg 1)
1753
          (progn
1754
            (re-search-forward page-delimiter (point-max) 1 (1- arg)))))
1755
  (skip-chars-forward sas-white-chars); was " \f\n" till 5.1.13
1756
  (recenter 1))
1757

1758
(defun forward-page-top-of-window (arg)
1759
  "Move forward to page boundary and leave first line at top of window.
1760
With arg, repeat, or go back if negative. A page boundary is any line
1761
whose beginning matches the regexp `page-delimiter'."
1762
  (interactive "p")
1763
  (forward-page arg)
1764
  (recenter 0))
1765

1766
(defun backward-page-top-of-window (arg)
1767
  "Move backward to page boundary and leave first line at top of window.
1768
With arg, repeat, or go back if negative. A page boundary is any line
1769
whose beginning matches the regexp `page-delimiter'."
1770
  (interactive "p")
1771
  (forward-page (- arg))
1772
  (recenter 0))
1773

1774
(defun sas-narrow-to-page ()
1775
  (save-excursion
1776
    (let* ((min (point-min))
1777
           (max (point-max)))
1778
      ;;(omin (point-min))
1779
      ;;(omax (point-max)))
1780
      (if (or (bolp) (beginning-of-line)
1781
              (looking-at page-delimiter))
1782
          (forward-char 1)
1783
        (forward-page -1))
1784
      (setq min (point))
1785
      (forward-page 1)
1786
      (beginning-of-line)
1787
      (setq max (point))
1788
      (narrow-to-region min max))))
1789

1790
(defun sas-forward-page-narrow (arg)
1791
  "Move forward to page boundary and narrow to page.
1792
With arg, repeat, or go back if negative. A page boundary is any line
1793
whose beginning matches the regexp `page-delimiter'."
1794
  (interactive "p")
1795
  (widen)
1796
  (forward-page arg)
1797
  (sas-narrow-to-page)
1798
  (goto-char (point-min)))
1799

1800
(defun sas-backward-page-narrow (arg)
1801
  "Move backward to page boundary and narrow to page.
1802
With arg, repeat, or go back if negative. A page boundary is any line
1803
whose beginning matches the regexp `page-delimiter'."
1804
  (interactive "p")
1805
  (goto-char (point-min))
1806
  (widen)
1807
  (forward-page (- arg))
1808
  (sas-narrow-to-page))
1809

1810
(defun sas-goto-dataset (&optional page)
1811
  (interactive)
1812
  (and sas-directory-name
1813
       (let ((page (or page (sas-get-file-number))))
1814
         ;;(dir sas-directory-name))
1815
         (if page
1816
             (progn
1817
               (switch-to-buffer-other-window
1818
                (concat "*SAS-cont-" sas-directory-name))
1819
               (widen)
1820
               (sas-goto-page page)
1821
               (sas-narrow-to-page)
1822
               (goto-char (point-min)))))))
1823

1824
;;(defun sas-mouse-goto-dataset (event)
1825
;;  (interactive "e")
1826
;;  (let (page buf)
1827
;;    (save-window-excursion
1828
;;      (save-excursion
1829
;;        (set-buffer (window-buffer (posn-window (event-end event))))
1830
;;        (save-excursion
1831
;;          (goto-char (posn-point (event-end event)))
1832
;;          (setq page (sas-get-file-number)))
1833
;;        (sas-goto-dataset page)
1834
;;        (setq buf (buffer-name))))
1835
;;    (set-buffer buf)
1836
;;    (goto-char (point-min))
1837
;;    (display-buffer buf)))
1838

1839

1840
(defun sas-dir-goto-page (page)
1841
  (interactive "p")
1842
  (widen)
1843
  (sas-goto-page page)
1844
  (sas-narrow-to-page))
1845

1846
(defun sas-mark-item (&optional next)
1847
  (interactive)
1848
  (sas-move-to-filename)
1849
  (beginning-of-line)
1850
  (let ((buffer-read-only nil))
1851
    (if (re-search-forward "^\\( *[0-9]+ *\\) \\([A-Z][A-Z_0-9]*\\) "
1852
                           (save-excursion (end-of-line) (point)) t)
1853
        (replace-match "\\1<\\2>")))
1854
  (or next (sas-next-line 1)))
1855

1856
(defun sas-unmark-item ()
1857
  (interactive)
1858
  (save-excursion
1859
    (beginning-of-line)
1860
    (let ((buffer-read-only nil))
1861
      (if (re-search-forward "^\\( *[0-9]+ *\\)<\\([A-Z][A-Z_0-9]*\\)>"
1862
                             (save-excursion (end-of-line) (point)) t)
1863
          (replace-match "\\1 \\2 ")))))
1864

1865
(defun sas-prev-line-undo (arg)
1866
  (interactive "p")
1867
  (sas-prev-line arg)
1868
  (sas-unmark-item)
1869
  (sas-move-to-filename))
1870

1871
(defun sas-create-var-string ()
1872
  (and (string-equal "*SAS-cont" (substring (buffer-name) 0 9))
1873
       (let (str)
1874
         (goto-char (point-min))
1875
         (while
1876
             (re-search-forward "^\\( *[0-9]+ *\\)<\\([A-Z][A-Z_0-9]*\\)>"
1877
                                nil t)
1878
           (setq str (concat str " " (buffer-substring (match-beginning 2)
1879
                                                       (match-end 2)))))
1880
         str)))
1881

1882

1883
(defun ess-imenu-SAS (&optional arg)
1884
  "SAS language Imenu support for ESS."
1885
  (interactive)
1886
  (setq imenu-generic-expression
1887
        '( (nil "[ \t\n=]\\([a-zA-Z_][a-zA-Z_0-9]*[.][a-zA-Z_][a-zA-Z_0-9]*\\)[ ,()\t\n;]" 1)))
1888
  (imenu-add-to-menubar "SAS Datasets"))
1889

1890
;;(defun sas-revert-library ()
1891
;;  "Update current library."
1892
;;  (interactive)
1893
;;  (if sas-directory-name
1894
;;      (sas-make-library sas-directory-name t)))
1895

1896
(provide 'ess-sas-l)
1897

1898
 ; Local variables section
1899

1900
;;; This file is automatically placed in Outline minor mode.
1901
;;; The file is structured as follows:
1902
;;; Chapters:     ^L ;
1903
;;; Sections:    ;;*;;
1904
;;; Subsections: ;;;*;;;
1905
;;; Components:  defuns, defvars, defconsts
1906
;;;              Random code beginning with a ;;;;* comment
1907
;;; Local variables:
1908
;;; mode: emacs-lisp
1909
;;; mode: outline-minor
1910
;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
1911
;;; End:
1912

1913
;;; ess-sas-l.el ends here
1914

1915
Product

Resources

Company
