Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
Download
2701 views
1
;;; ess-s-l.el --- Support for editing S source code
2
3
;; Copyright (C) 1989-1997 D. Bates, Kademan, Ritter, D.M. Smith, K. Hornik,
4
;; R.M. Heiberger, M. Maechler, and A.J. Rossini.
5
;; Copyright (C) 1998-2005 A.J. Rossini, Richard M. Heiberger, Martin
6
;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
7
8
;; Author: A.J. Rossini <[email protected]>
9
;; Created: 26 Aug 1997
10
;; Maintainer: ESS-core <[email protected]>
11
12
;; This file is part of ESS (Emacs Speaks Statistics).
13
14
;; This file is free software; you can redistribute it and/or modify
15
;; it under the terms of the GNU General Public License as published by
16
;; the Free Software Foundation; either version 2, or (at your option)
17
;; any later version.
18
19
;; This file is distributed in the hope that it will be useful,
20
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22
;; GNU General Public License for more details.
23
24
;; A copy of the GNU General Public License is available at
25
;; http://www.r-project.org/Licenses/
26
27
;;; Commentary:
28
29
;; Code for general editing S source code (specializes to S, S+, R).
30
31
;;; Code:
32
33
; Requires and autoloads
34
35
(ess-message "[ess-s-l:] (def** ) only ...")
36
37
; Configuration variables
38
39
(defvar S-syntax-table
40
(let ((S-syntax-table (make-syntax-table)))
41
(modify-syntax-entry ?\\ "\\" S-syntax-table)
42
(modify-syntax-entry ?+ "." S-syntax-table)
43
(modify-syntax-entry ?- "." S-syntax-table)
44
(modify-syntax-entry ?= "." S-syntax-table)
45
(modify-syntax-entry ?% "." S-syntax-table)
46
(modify-syntax-entry ?< "." S-syntax-table)
47
(modify-syntax-entry ?> "." S-syntax-table)
48
(modify-syntax-entry ?& "." S-syntax-table)
49
(modify-syntax-entry ?| "." S-syntax-table)
50
(modify-syntax-entry ?\' "\"" S-syntax-table)
51
(modify-syntax-entry ?\" "\"" S-syntax-table)
52
(modify-syntax-entry ?# "<" S-syntax-table) ; open comment
53
(modify-syntax-entry ?\n ">" S-syntax-table) ; close comment
54
;;(modify-syntax-entry ?. "w" S-syntax-table) ; "." used in S obj names
55
(modify-syntax-entry ?. "_" S-syntax-table) ; see above/below,
56
; plus consider separation.
57
(modify-syntax-entry ?$ "_" S-syntax-table); foo$comp = 1 symbol(completion)
58
(modify-syntax-entry ?@ "_" S-syntax-table); foo@slot = 1 symbol(completion)
59
(modify-syntax-entry ?_ "_" S-syntax-table)
60
(modify-syntax-entry ?: "_" S-syntax-table)
61
(modify-syntax-entry ?* "." S-syntax-table)
62
(modify-syntax-entry ?< "." S-syntax-table)
63
(modify-syntax-entry ?> "." S-syntax-table)
64
(modify-syntax-entry ?/ "." S-syntax-table)
65
S-syntax-table)
66
"Syntax table for S code."
67
)
68
69
(defvar S-editing-alist
70
'((paragraph-start . (concat "\\s-*$\\|" page-delimiter))
71
(paragraph-separate . (concat "\\s-*$\\|" page-delimiter))
72
(paragraph-ignore-fill-prefix . t)
73
(require-final-newline . mode-require-final-newline)
74
;;(comment-indent-function . 'S-comment-indent)
75
;;(ess-comment-indent . 'S-comment-indent)
76
;;(ess-indent-line . 'S-indent-line)
77
;;(ess-calculate-indent . 'ess-calculate-indent)
78
(indent-line-function . 'ess-indent-line)
79
(parse-sexp-ignore-comments . t)
80
(ess-style . ess-default-style)
81
;;(ess-keep-dump-files . 'ask)
82
(ess-mode-syntax-table . S-syntax-table)
83
;; For Changelog add, require ' ' before <- : "attr<-" is a function name :
84
(add-log-current-defun-header-regexp . "^\\(.+\\)\\s-+<-[ \t\n]*function")
85
(ess-font-lock-keywords . 'ess-S-font-lock-keywords)
86
(ess-font-lock-defaults . (ess--extract-default-fl-keywords ess-S-font-lock-keywords))
87
(font-lock-defaults . '(ess-font-lock-defaults
88
nil nil ((?\. . "w") (?\_ . "w"))))
89
)
90
"General options for S and S+ source files.")
91
92
(defvar inferior-S-language-start
93
'(concat "options("
94
"STERM='" ess-STERM "'"
95
", str.dendrogram.last=\"'\""
96
(if ess-editor (concat ", editor='" ess-editor "'"))
97
(if ess-pager (concat ", pager='" ess-pager "', help.pager='" ess-pager "'"))
98
", show.error.locations=TRUE"
99
")")
100
"S language expression for startup -- default for all S dialects.")
101
102
(defconst S-common-cust-alist
103
'((ess-language . "S")
104
(inferior-ess-exit-command . "q()\n")
105
(inferior-ess-language-start . (eval inferior-S-language-start))
106
(comint-use-prompt-regexp . t) ;;use fields if nil
107
(comint-process-echoes . t)
108
;; these prompt are the same for all S-languages As long as custom prompt
109
;; ends in inferior-ess-primary-prompt everything should work as expected.
110
(inferior-ess-primary-prompt . "> ")
111
;; (inferior-ess-secondary-prompt . "[+:] ") ;; catch Selection: and alike
112
(inferior-ess-secondary-prompt . "+ ") ;; catch Selection: and alike
113
(comment-start . "#")
114
(ess-imenu-generic-expression . ess-imenu-S-generic-expression)
115
(comment-add . 1)
116
(comment-start-skip . "#+ *")
117
(comment-use-syntax . t) ; see log for bug report 2013-06-07
118
(comment-column . 40)
119
(ess-no-skip-regexp . (concat "^ *@\\|" (default-value 'ess-no-skip-regexp)))
120
;; inferior-ess-prompt is used by comint for navigation, only if
121
;; comint-use-prompt-regexp is t; (transcript-mode also relies on this regexp)
122
(inferior-ess-prompt . inferior-S-prompt) ;customizable
123
(ess-get-help-topics-function . 'ess-get-S-help-topics-function)
124
(ess-getwd-command . "getwd()\n")
125
(ess-setwd-command . "setwd('%s')\n")
126
(ess-funargs-command . ".ess_funargs(\"%s\")\n")
127
128
(fill-nobreak-predicate . 'ess-inside-string-p)
129
(normal-auto-fill-function . 'ess-do-auto-fill)
130
)
131
"S-language common settings for all <dialect>-customize-alist s")
132
133
(defconst S+common-cust-alist
134
(append
135
'((ess-suffix . "S")
136
(ess-mode-syntax-table . S-syntax-table)
137
(ess-help-sec-regex . ess-help-S+-sec-regex)
138
(ess-help-sec-keys-alist . ess-help-S+sec-keys-alist)
139
(ess-change-sp-regexp . ess-S+-change-sp-regexp)
140
(ess-cmd-delay . (if (featurep 'xemacs); needs much less delay
141
(* 0.1 ess-S+-cmd-delay)
142
ess-S+-cmd-delay))
143
(ess-function-pattern . ess-S-function-pattern)
144
(ess-function-template . " <- \n#\nfunction()\n{\n\n}\n")
145
(ess-dump-filename-template . (ess-replace-regexp-in-string
146
"S$" ess-suffix ; in the one from custom:
147
ess-dump-filename-template-proto))
148
(ess-traceback-command . "traceback()\n")
149
(ess-mode-editing-alist . S-editing-alist)
150
151
(ess-dumped-missing-re
152
. "\\(\\(<-\\|=\\)\nDumped\n\\'\\)\\|\\(\\(<-\\|=\\)\\(\\s \\|\n\\)*\\'\\)")
153
(ess-syntax-error-re
154
. "\\(Syntax error: .*\\) at line \\([0-9]*\\), file \\(.*\\)$")
155
(inferior-ess-objects-command . inferior-Splus-objects-command)
156
(ess-describe-object-at-point-commands . 'ess-S-describe-object-at-point-commands)
157
(inferior-ess-font-lock-keywords . 'inferior-S-font-lock-keywords)
158
(ess-editor . S-editor)
159
(ess-pager . S-pager)
160
)
161
S-common-cust-alist)
162
"Common settings for all S+<*>-customize-alist s"
163
)
164
165
;;; Changes from S to S-PLUS 3.x. (standard S3 should be in ess-s-l!).
166
167
(defconst ess-help-S+sec-keys-alist
168
'((?a . "ARGUMENTS:")
169
(?b . "BACKGROUND:")
170
(?B . "BUGS:")
171
(?d . "DESCRIPTION:")
172
(?D . "DETAILS:")
173
(?e . "EXAMPLES:")
174
(?n . "NOTE:")
175
(?O . "OPTIONAL ARGUMENTS:")
176
(?R . "REQUIRED ARGUMENTS:")
177
(?r . "REFERENCES:")
178
(?s . "SEE ALSO:")
179
(?S . "SIDE EFFECTS:")
180
(?u . "USAGE:")
181
(?v . "VALUE:"))
182
"Alist of (key . string) pairs for use in section searching.")
183
;;; `key' indicates the keystroke to use to search for the section heading
184
;;; `string' in an S help file. `string' is used as part of a
185
;;; regexp-search, and so specials should be quoted.
186
187
;; S ver.3 (NOT S-Plus)
188
(defconst ess-help-S3-sec-keys-alist
189
'((?a . "ARGUMENTS:")
190
(?b . "BACKGROUND:")
191
(?B . "BUGS:")
192
(?d . "DESCRIPTION:")
193
(?D . "DETAILS:")
194
(?e . "EXAMPLES:")
195
(?n . "NOTE:")
196
(?r . "REFERENCES:")
197
(?s . "SEE ALSO:")
198
(?S . "SIDE EFFECTS:")
199
(?u . "USAGE:")
200
(?v . "VALUE:"))
201
"Help section keys for S ver.3.")
202
203
;; S ver.4 (NOT S-Plus)
204
(defconst ess-help-S4-sec-keys-alist
205
'((?a . "ARGUMENTS:")
206
(?b . "BACKGROUND:")
207
(?B . "BUGS:")
208
(?d . "DESCRIPTION:")
209
(?D . "DETAILS:")
210
(?e . "EXAMPLES:")
211
(?n . "NOTE:")
212
(?r . "REFERENCES:")
213
(?s . "SEE ALSO:")
214
(?S . "SIDE EFFECTS:")
215
(?u . "USAGE:")
216
(?v . "VALUE:"))
217
"Help section keys for S4.")
218
219
;; R
220
(defconst ess-help-R-sec-keys-alist
221
'((?a . "\\s *Arguments:")
222
(?d . "\\s *Description:")
223
(?D . "\\s *Details:")
224
(?t . "\\s *Details:")
225
(?e . "\\s *Examples:")
226
(?n . "\\s *Note:")
227
(?r . "\\s *References:")
228
(?s . "\\s *See Also:")
229
(?u . "\\s *Usage:")
230
(?v . "\\s *Value[s]?") ;
231
)
232
"Alist of (key . string) pairs for use in help section searching.")
233
234
235
(defconst ess-help-S+-sec-regex "^[A-Z. ---]+:$"
236
"Reg(ular) Ex(pression) of section headers in help file.")
237
238
(defconst ess-help-R-sec-regex "^[A-Z][A-Za-z].+:$"
239
"Reg(ular) Ex(pression) of section headers in help file.")
240
241
;;; S-mode extras of Martin Maechler, Statistik, ETH Zurich.
242
;;; See also ./ess-utils.el
243
244
(defvar ess-function-outline-file
245
(concat ess-etc-directory "/function-outline.S")
246
"The file name of the ess-function outline that is to be inserted at point,
247
when \\[ess-insert-function-outline] is used.
248
Placeholders (substituted `at runtime'): $A$ for `Author', $D$ for `Date'.")
249
250
;; Use the user's own ~/S/emacs-fun.outline if (s)he has one : ---
251
(let ((outline-file (concat (getenv "HOME") "/S/function-outline.S")))
252
(if (file-exists-p outline-file)
253
(setq ess-function-outline-file outline-file)))
254
255
;; Seth's idea; see ess-toggle-S-assign-key below
256
(defvar ess-S-assign-key [?\C-=] ;; = "\C-c=" ; old-default: "_"
257
"This key is mapped to insert `ess-S-assign' (by default '<-'),
258
when \\[ess-toggle-S-assign-key] is called.")
259
260
(defvar ess-S-assign-key-last nil
261
"This caches the previous value (binding) of `ess-S-assign-key'. It allows
262
\\[ess-toggle-S-assign-key] to toggle back to the previous definition.")
263
264
; Function Definitions
265
266
(defun S-comment-indent ()
267
"Indentation for S comments."
268
(if (or (looking-at "###")
269
(and (looking-at "#!") (= 1 (line-number-at-pos))))
270
(current-column)
271
(if (looking-at "##")
272
(let ((tem (ess-calculate-indent)))
273
(if (listp tem) (car tem) tem))
274
(skip-chars-backward " \t")
275
(max (if (bolp) 0 (1+ (current-column)))
276
comment-column))))
277
278
;; VS: these are ess-indent-line and ess-calculate-indent from 2004 already,so
279
;; commented out to avoid confusion:
280
281
;; (defun S-indent-line ()
282
;; "Indent current line as S code.
283
;; Return the amount the indentation changed by."
284
;; (let ((indent (S-calculate-indent nil))
285
;; beg shift-amt
286
;; (case-fold-search nil)
287
;; (pos (- (point-max) (point))))
288
;; (beginning-of-line)
289
;; (setq beg (point))
290
;; (cond ((eq indent nil)
291
;; (setq indent (current-indentation)))
292
;; (t
293
;; (skip-chars-forward " \t")
294
;; (cond ((and ess-fancy-comments ;; ### or #!
295
;; (or (looking-at "###")
296
;; (and (looking-at "#!") (= 1 (line-number-at-pos)))))
297
;; (setq indent 0))
298
;; ;; Single # comment
299
;; ((and ess-fancy-comments
300
;; (looking-at "#") (not (looking-at "##")))
301
;; (setq indent comment-column))
302
;; (t
303
;; (if (eq indent t) (setq indent 0))
304
;; (if (listp indent) (setq indent (car indent)))
305
;; (cond ((and (looking-at "else\\b")
306
;; (not (looking-at "else\\s_")))
307
;; (setq indent (save-excursion
308
;; (ess-backward-to-start-of-if)
309
;; (+ ess-else-offset (current-indentation)))))
310
;; ((= (following-char) ?})
311
;; (setq indent
312
;; (+ indent
313
;; (- ess-close-brace-offset ess-indent-level))))
314
;; ((= (following-char) ?{)
315
;; (setq indent (+ indent ess-brace-offset))))))))
316
;; (skip-chars-forward " \t")
317
;; (setq shift-amt (- indent (current-column)))
318
;; (if (zerop shift-amt)
319
;; (if (> (- (point-max) pos) (point))
320
;; (goto-char (- (point-max) pos)))
321
;; (delete-region beg (point))
322
;; (indent-to indent)
323
;; ;; If initial point was within line's indentation,
324
;; ;; position after the indentation.
325
;; ;; Else stay at same point in text.
326
;; (if (> (- (point-max) pos) (point))
327
;; (goto-char (- (point-max) pos))))
328
;; shift-amt))
329
330
;; (defun S-calculate-indent (&optional parse-start)
331
;; "Return appropriate indentation for current line as S code.
332
;; In usual case returns an integer: the column to indent to.
333
;; Returns nil if line starts inside a string, t if in a comment."
334
;; (save-excursion
335
;; (beginning-of-line)
336
;; (let ((indent-point (point))
337
;; (beginning-of-defun-function nil) ;; don't call ess-beginning-of-function
338
;; (case-fold-search nil)
339
;; state
340
;; containing-sexp)
341
;; (if parse-start
342
;; (goto-char parse-start)
343
;; (beginning-of-defun))
344
;; (while (< (point) indent-point)
345
;; (setq parse-start (point))
346
;; (setq state (parse-partial-sexp (point) indent-point 0))
347
;; (setq containing-sexp (car (cdr state))))
348
;; (cond ((or (nth 3 state) (nth 4 state))
349
;; ;; return nil or t if should not change this line
350
;; (nth 4 state))
351
;; ((null containing-sexp)
352
;; ;; Line is at top level. May be data or function definition,
353
;; (beginning-of-line)
354
;; (if (and (/= (following-char) ?\{)
355
;; (save-excursion
356
;; (ess-backward-to-noncomment (point-min))
357
;; (ess-continued-statement-p)))
358
;; ess-continued-statement-offset
359
;; 0)) ; Unless it starts a function body
360
;; ((/= (char-after containing-sexp) ?{)
361
;; ;; line is expression, not statement:
362
;; ;; indent to just after the surrounding open.
363
;; (goto-char containing-sexp)
364
;; (let ((bol (save-excursion (beginning-of-line) (point))))
365
366
;; ;; modified by shiba@isac 7.3.1992
367
;; (cond ((and (numberp ess-expression-offset)
368
;; (re-search-backward "[ \t]*expression[ \t]*" bol t))
369
;; ;; This regexp match every "expression".
370
;; ;; modified by shiba
371
;; ;;(forward-sexp -1)
372
;; (beginning-of-line)
373
;; (skip-chars-forward " \t")
374
;; ;; End
375
;; (+ (current-column) ess-expression-offset))
376
;; ((and (numberp ess-arg-function-offset)
377
;; (re-search-backward
378
;; "=[ \t]*\\s\"?\\(\\w\\|\\s_\\)+\\s\"?[ \t]*"
379
;; bol
380
;; t))
381
;; (forward-sexp -1)
382
;; (+ (current-column) ess-arg-function-offset))
383
;; ;; "expression" is searched before "=".
384
;; ;; End
385
386
;; (t
387
;; (progn (goto-char (1+ containing-sexp))
388
;; (current-column))))))
389
;; (t
390
;; ;; Statement level. Is it a continuation or a new statement?
391
;; ;; Find previous non-comment character.
392
;; (goto-char indent-point)
393
;; (ess-backward-to-noncomment containing-sexp)
394
;; ;; Back up over label lines, since they don't
395
;; ;; affect whether our line is a continuation.
396
;; (while (eq (preceding-char) ?\,)
397
;; (ess-backward-to-start-of-continued-exp containing-sexp)
398
;; (beginning-of-line)
399
;; (ess-backward-to-noncomment containing-sexp))
400
;; ;; Now we get the answer.
401
;; (if (ess-continued-statement-p)
402
;; ;; This line is continuation of preceding line's statement;
403
;; ;; indent ess-continued-statement-offset more than the
404
;; ;; previous line of the statement.
405
;; (progn
406
;; (ess-backward-to-start-of-continued-exp containing-sexp)
407
;; (+ ess-continued-statement-offset (current-column)
408
;; (if (save-excursion (goto-char indent-point)
409
;; (skip-chars-forward " \t")
410
;; (eq (following-char) ?{))
411
;; ess-continued-brace-offset 0)))
412
;; ;; This line starts a new statement.
413
;; ;; Position following last unclosed open.
414
;; (goto-char containing-sexp)
415
;; ;; Is line first statement after an open-brace?
416
;; (or
417
;; ;; If no, find that first statement and indent like it.
418
;; (save-excursion
419
;; (forward-char 1)
420
;; (while (progn (skip-chars-forward " \t\n")
421
;; (looking-at "#"))
422
;; ;; Skip over comments following openbrace.
423
;; (forward-line 1))
424
;; ;; The first following code counts
425
;; ;; if it is before the line we want to indent.
426
;; (and (< (point) indent-point)
427
;; (current-column)))
428
;; ;; If no previous statement,
429
;; ;; indent it relative to line brace is on.
430
;; ;; For open brace in column zero, don't let statement
431
;; ;; start there too. If ess-indent-level is zero, use
432
;; ;; ess-brace-offset + ess-continued-statement-offset
433
;; ;; instead.
434
;; ;; For open-braces not the first thing in a line,
435
;; ;; add in ess-brace-imaginary-offset.
436
;; (+ (if (and (bolp) (zerop ess-indent-level))
437
;; (+ ess-brace-offset ess-continued-statement-offset)
438
;; ess-indent-level)
439
;; ;; Move back over whitespace before the openbrace.
440
;; ;; If openbrace is not first nonwhite thing on the line,
441
;; ;; add the ess-brace-imaginary-offset.
442
;; (progn (skip-chars-backward " \t")
443
;; (if (bolp) 0 ess-brace-imaginary-offset))
444
;; ;; If the openbrace is preceded by a parenthesized exp,
445
;; ;; move to the beginning of that;
446
;; ;; possibly a different line
447
;; (progn
448
;; (if (eq (preceding-char) ?\))
449
;; (forward-sexp -1))
450
;; ;; Get initial indentation of the line we are on.
451
;; (current-indentation))))))))))
452
453
(defun ess-insert-function-outline ()
454
"Insert an S function definition `outline' at point.
455
Uses the file given by the variable `ess-function-outline-file'."
456
(interactive)
457
(let ((oldpos (point)))
458
(save-excursion
459
(insert-file-contents ess-function-outline-file)
460
(if (search-forward "$A$" nil t)
461
(replace-match (user-full-name) 'not-upcase 'literal))
462
(goto-char oldpos)
463
(if (search-forward "$D$" nil t)
464
(replace-match (ess-time-string 'clock) 'not-upcase 'literal)))
465
(goto-char (1+ oldpos))))
466
467
468
;; typically bound to M-Enter
469
(defun ess-use-this-dir (&optional no-force-current)
470
"Synchronise the current directory of the S or R process to the one of the current
471
buffer. If that buffer has no associated *R* process, use \\[ess-force-buffer-current],
472
unless prefix argument NO-FORCE-CURRENT is non-nil."
473
(interactive "P")
474
(unless no-force-current (ess-force-buffer-current "R process to use: "))
475
(if ess-local-process-name
476
(let ((cmd (format "setwd('%s')\n" default-directory))
477
)
478
(unless (string= ess-language "S")
479
;; FIXME: generalize this for Stata, SAS, Xlispstat... -- then move to ess-mode.el
480
(error
481
"ESS setting working directory in *%s* not yet implemented for language %s"
482
ess-local-process-name ess-language))
483
(ess-command cmd)
484
(message "Directory of *%s* process set to %s"
485
ess-local-process-name default-directory))
486
;; no local process
487
(message "No *%s* process associated with this buffer." ess-dialect)))
488
489
490
;;*;; S/R Pretty-Editing
491
492
(defun ess-fix-comments (&optional dont-query verbose)
493
"Fix ess-mode buffer so that single-line comments start with at least '##',
494
and ensure space before subsequent text."
495
(interactive "P")
496
(ess-replace-regexp-dump-to-src "#\\([A-Za-z0-9]\\)" "# \\1" nil verbose)
497
(ess-replace-regexp-dump-to-src "^\\([ \t]*#\\)\\([^#]\\)"
498
"\\1#\\2" dont-query verbose))
499
500
(defun ess-dump-to-src (&optional dont-query verbose)
501
"Make the changes in an S - dump() file to improve human readability."
502
(interactive "P")
503
(ess-replace-regexp-dump-to-src "^\"\\([a-z.][a-z.0-9]*\\)\" *<-\n"
504
"\n\\1 <- "
505
dont-query verbose 'ensure-ess))
506
507
(defun ess-num-var-round (&optional dont-query verbose)
508
"Is VERY useful for dump(.)'ed numeric variables; ROUND some of them by
509
replacing endings of 000000*.. and 999999*. Martin Maechler"
510
(interactive "P")
511
(save-excursion
512
(goto-char (point-min))
513
514
(let ((num 0)
515
(str "")
516
(rgxp "000000+[1-9]?[1-9]?\\>")
517
(to ""))
518
(if dont-query
519
(ess-rep-regexp rgxp to nil nil verbose)
520
(query-replace-regexp rgxp to nil))
521
522
(while (< num 9)
523
(setq str (concat (int-to-string num) "999999+[0-8]*"))
524
(if (and (numberp verbose) (> verbose 1))
525
(message (format "\nregexp: '%s'" str)))
526
(goto-char (point-min))
527
(ess-rep-regexp str (int-to-string (1+ num))
528
'fixedcase 'literal verbose)
529
(setq num (1+ num))))))
530
531
(defun ess-fix-dot (before-chars &optional dont-query verbose)
532
"Remove trailing decimal '.' (\"dot\"), before BEFORE; typically from S-plus"
533
;; typically, before-chars = "]:" or more
534
(ess-replace-regexp-dump-to-src
535
(concat "\\([0-9]\\)\\.\\( *[" before-chars "]\\)")
536
;; 111 ^
537
"\\1\\2" dont-query verbose))
538
539
(defun ess-fix-dot-1 (&optional do-query verbose)
540
"Remove trailing decimal '.' (\"dot\"), before ':' or ']', i.e.,
541
in cases where it's ugly and nonsense. DO-QUERY(prefix) asks before replacing."
542
(interactive "P")
543
(ess-fix-dot "]:" (not do-query) verbose))
544
545
(defun ess-fix-dot-more (&optional dont-query verbose)
546
"Remove trailing decimal '.' (\"dot\", typically from S+) in more cases
547
than `ess-fix-dot-1'."
548
(interactive "P")
549
(ess-fix-dot-1 nil verbose)
550
(ess-fix-dot ",)" dont-query verbose))
551
552
(defun ess-fix-EQ-assign (&optional dont-query verbose not-all)
553
"Replace \"=\" by \"<-\" in places where it 'might make sense', e.g.,
554
for function assignments and lines not ending in \",\".
555
Be *careful* for list()s of functions and when argument not-all is
556
nil (as by default) !"
557
;;TODO: "in the few places we can be very sure.."
558
;;---- is hard in general: local functions: ok; but functions in
559
;; list(a = function(x) abs(x), b= function(y) bound(y)) *NOT* ok!
560
(interactive "P")
561
(ess-replace-regexp-dump-to-src
562
"^\\( *[a-z.][_a-z.0-9]*\\) *= *\\(function *(\\)"
563
"\\1 <- \\2" dont-query verbose)
564
565
(unless not-all
566
;; "too" aggressive {proposing to replace function argument specs}:
567
(ess-replace-regexp-dump-to-src ;; all those *not* ending in ","
568
;; including Mat[ i, ] = ...,
569
;; but not `names(x) = "..."' for that is "confused" with plot(x=x,..)
570
"^\\( *[a-z.][][, \"_a-z.0-9]*\\) *= *\\([a-z.0-9({]\\(.*[^,]\\)? *$\\)"
571
"\\1 <- \\2" nil ;; always query - often has many "false positives"
572
verbose)
573
))
574
575
;;; All of the above three :
576
(defun ess-MM-fix-src (&optional dont-query verbose)
577
"Clean up ess-source code which has been produced by dump(..), and other
578
code typically produced by other tools. Produces more readable code,
579
and one that is well formatted in emacs ess-mode."
580
(interactive "P")
581
;; each of the following does a save-excursion:
582
(ess-dump-to-src dont-query)
583
(ess-fix-comments dont-query)
584
(ess-num-var-round dont-query verbose)
585
(ess-fix-dot-more dont-query verbose)
586
(ess-fix-EQ-assign dont-query verbose 'not-all)
587
)
588
589
(defun ess-fix-miscellaneous (&optional from verbose)
590
"Fix Miscellaneous S/R `ill-formation's from current \\[point].
591
Particularly use \"<-\"and put spaces around operators."
592
(interactive "d\nP"); Defaults: point and prefix (C-u)
593
;; activate by (setq ess-verbose t)
594
(ess-if-verbose-write
595
(format "ess-fix-misc begin (from = %s, verbose = %s)\n" from verbose))
596
(save-excursion
597
598
(if (string= ess-dialect "R")
599
(progn
600
(require 'ess-r-d)
601
(R-fix-T-F from (not verbose))))
602
603
;; activate by (setq ess-verbose t)
604
(ess-if-verbose-write "ess-fix-misc: after fix-T-F\n");___D___
605
606
;; former C and matlab programmers leave trailing ";" :
607
;; (goto-char from) (ess-rep-regexp "; *$" "" nil 'literal verbose)
608
;; (ess-if-verbose-write "ess-fix-misc: after trailing ';'\n");___D___
609
(goto-char from) (ess-rep-regexp ";\\( *\\)#" "\\1#" nil nil verbose)
610
(ess-if-verbose-write "ess-fix-misc: after ';' before #\n");___D___
611
612
;;from R 1.9.x "_" is valid in names; here assume no initial / trailing '_'
613
;; BUG: The following changes "beta_ " or " _abc"
614
;; (goto-char from) (ess-rep-regexp " +_ *" " <- " nil 'literal verbose)
615
;; (goto-char from) (ess-rep-regexp "_ +" " <- " nil 'literal verbose)
616
617
(ess-if-verbose-write "ess-fix-misc: before 'around \"<-\"' :\n");___D___
618
;; ensure space around "<-" ---- but only replace if necessary:
619
(goto-char from)
620
(ess-rep-regexp "\\([^< \t\n]\\)\\(<<?-\\)" "\\1 \\2" nil nil verbose)
621
(goto-char from)(ess-rep-regexp "<-\\([^ \t\n]\\)" "<- \\1" nil nil verbose)
622
;; ensure space around "<" (not in "<-","<=","<<-") and ">" (not ">=") :
623
(goto-char from);; --> " <", care with "->":
624
(ess-rep-regexp "\\([^-< \t\n]\\)\\([<>]\\)" "\\1 \\2" nil nil verbose)
625
;; ">" -> "> " , for "<", don't split "<-" nor "<<-":
626
(goto-char from)
627
(ess-rep-regexp "\\(>=?\\)\\([^= \t\n]\\)" "\\1 \\2" nil nil verbose)
628
(goto-char from)
629
(ess-rep-regexp "\\(<=?\\)\\([^-<= \t\n]\\)" "\\1 \\2" nil nil t)
630
631
(ess-if-verbose-write "ess-fix-misc: before \"=\" \"==\" .. :\n");___D___
632
;; -- ensure space around "=", "==", "!=" :
633
(goto-char from) ;; --> " ="
634
(ess-rep-regexp "\\([^=!<> ]\\)\\([=!]?\\)=" "\\1 \\2=" nil nil verbose)
635
(goto-char from) (ess-rep-regexp "=\\([^= ]\\)" "= \\1" nil nil verbose)
636
637
(goto-char from) ;; add a space between "{" and surrounding ..char:
638
(ess-rep-regexp "{\\([.A-Za-z()]\\)" "{ \\1" 'fix nil verbose)
639
(ess-rep-regexp "\\([()]\\){" "\\1 {" 'fix nil verbose)
640
(goto-char from) ;; add a space between "}" and a preceding wordchar:
641
(ess-rep-regexp "\\([A-Za-z0-9()]\\)}" "\\1 }" 'fix nil verbose)
642
(ess-space-around "else" from verbose)
643
644
(ess-if-verbose-write "ess-fix-misc: after \"{ ... }\" :\n");___D___
645
(goto-char from) ;; add a space inside "){"
646
(ess-rep-regexp "){" ") {" 'fix nil verbose)
647
648
;; add a newline and indent before a "}"
649
;; --- IFF there's NO "{" or "#" AND some NON-white text on the same line:
650
;;D (if verbose (message "\t R-fix-misc..: Hard.. '}'"))
651
(goto-char from)
652
(ess-rep-regexp "^\\([^#{\n]*[^#{ \t\n]+[ \t]*\\)}[ \t]*$"
653
"\\1\n}" 'fix nil verbose)
654
(ess-if-verbose-write "ess-fix-misc __end__\n");___D___
655
))
656
657
;; This is by Seth Falcon, modeled after ess-toggle-underscore (see below).
658
(defun ess-toggle-S-assign-key (force)
659
"Possibly bind the key in `ess-S-assign-key' to inserting `ess-S-assign'.
660
If `ess-S-assign-key' is \"_\", simply use \\[ess-toggle-underscore].
661
Otherwise, unless the prefix argument FORCE is set,
662
toggle between the new and the previous assignment."
663
(interactive "P")
664
(require 'ess-mode)
665
(require 'ess-inf)
666
(let ((current-action (lookup-key ess-mode-map ess-S-assign-key))
667
(insert-S-assign (lambda() (interactive)
668
(delete-horizontal-space) (insert ess-S-assign))))
669
(if (and (stringp ess-S-assign-key)
670
(string= ess-S-assign-key "_"))
671
(ess-toggle-underscore force)
672
;; else "do things here"
673
(let* ((current-is-S-assign (eq current-action insert-S-assign))
674
(new-action (if force insert-S-assign
675
;; else "not force" (default):
676
(if (or current-is-S-assign
677
(eq ess-S-assign-key-last insert-S-assign))
678
ess-S-assign-key-last
679
insert-S-assign))))
680
(message "[ess-toggle-S-assign-key:] current: '%s', new: '%s'"
681
current-action new-action)
682
(define-key ess-mode-map ess-S-assign-key new-action)
683
(define-key inferior-ess-mode-map ess-S-assign-key new-action)
684
(if (not (and force current-is-S-assign))
685
(setq ess-S-assign-key-last current-action))))))
686
687
(defvar polymode-mode)
688
(defun ess-smart-S-assign ()
689
"Smart \\[ess-smart-S-assign] key: insert `ess-S-assign', unless in string/comment.
690
If the underscore key is pressed a second time, the assignment
691
operator is removed and replaced by the underscore. `ess-S-assign',
692
typically \" <- \", can be customized. In ESS modes other than R/S,
693
the underscore is always inserted. "
694
(interactive)
695
;;(insert (if (ess-inside-string-or-comment-p (point)) "_" ess-S-assign))
696
(save-restriction
697
(ignore-errors
698
(when (and (eq major-mode 'inferior-ess-mode)
699
(> (point) (process-mark (get-buffer-process (current-buffer)))))
700
(narrow-to-region (process-mark (ess-get-process)) (point-max)))
701
(and ess-noweb-mode
702
(ess-noweb-in-code-chunk)
703
(ess-noweb-narrow-to-chunk))
704
(and (fboundp 'pm/narrow-to-span)
705
polymode-mode
706
(pm/narrow-to-span)))
707
(if (or
708
(ess-inside-string-or-comment-p (point))
709
(not (equal ess-language "S")))
710
(insert ess-smart-S-assign-key)
711
;; else:
712
(ess-insert-S-assign))))
713
(defalias 'ess-smart-underscore 'ess-smart-S-assign)
714
715
(defun ess-insert-S-assign ()
716
"Insert the assignment operator `ess-S-assign', unless it is already there.
717
In that case, the it is removed and replaced by
718
`ess-smart-S-assign-key', \\[ess-smart-S-assign-key].
719
`ess-S-assign', typically \" <- \", can be customized."
720
(interactive)
721
;; one keypress produces ess-S-assign; a second keypress will delete
722
;; ess-S-assign and instead insert _
723
;; Rather than trying to count a second _ keypress, just check whether
724
;; the current point is preceded by ess-S-assign.
725
(let ((assign-len (length ess-S-assign)))
726
(if (and
727
(>= (point) (+ assign-len (point-min))) ;check that we can move back
728
(save-excursion
729
(backward-char assign-len)
730
(looking-at ess-S-assign)))
731
;; If we are currently looking at ess-S-assign, replace it with _
732
(progn
733
(delete-char (- assign-len))
734
(insert ess-smart-S-assign-key))
735
(if (string= ess-smart-S-assign-key "_")
736
(delete-horizontal-space))
737
(insert ess-S-assign))))
738
739
(defun ess-toggle-S-assign (force)
740
"Set the `ess-smart-S-assign-key' (by default \"_\"
741
[underscore]) key to \\[ess-smart-S-assign] or back to
742
`ess-smart-S-assign-key'. Toggle the current definition, unless
743
FORCE is non-nil, where \\[ess-smart-S-assign] is set
744
unconditionally.
745
746
If you as per default have `ess-smart-S-assign-key' set to
747
underscore, note that using \"C-q _\" will always just insert the
748
underscore character."
749
(interactive "P")
750
(let ((current-key (lookup-key ess-mode-map ess-smart-S-assign-key))
751
(default-key (lookup-key ess-mode-map "_"))
752
)
753
(if (and (or default-key current-key)
754
;; (stringp current-key) (string= current-key ess-S-assign)
755
(not force))
756
(progn
757
(define-key ess-mode-map "_" nil)
758
(define-key inferior-ess-mode-map "_" nil)
759
(define-key ess-mode-map ess-smart-S-assign-key nil); 'self-insert-command
760
(define-key inferior-ess-mode-map ess-smart-S-assign-key nil))
761
;; else : "force" or current-key is "nil", i.e. default
762
(define-key ess-mode-map ess-smart-S-assign-key
763
'ess-smart-S-assign)
764
(define-key inferior-ess-mode-map ess-smart-S-assign-key
765
'ess-smart-S-assign))))
766
(defalias 'ess-toggle-underscore 'ess-toggle-S-assign)
767
;; NOTA BENE: "_" is smart *by default* :
768
;; ----- The user can always customize `ess-S-assign' ...
769
(ess-toggle-S-assign 'force-to-S-assign)
770
771
(defun ess-add-MM-keys ()
772
"Define MM's user keys, currently \\<ess-mode-map>\\[ess-insert-function-outline], and
773
\\<inferior-ess-mode-map>\\[ess-execute-screen-options]."
774
(interactive)
775
(require 'ess-mode); typically unnecessary
776
(require 'ess-inf); dito
777
(define-key ess-mode-map "\C-cf" 'ess-insert-function-outline)
778
(define-key inferior-ess-mode-map "\C-cw" 'ess-execute-screen-options)
779
780
;; Make M-- : [Alt] + [-] (in addition to / instead of "_" = (on US-keyboard) [Shift]+ [-]
781
;; Note this overwrites 'M--' as "negative argument" (still on 'C--'):
782
(define-key ess-mode-map [?\M--] 'ess-insert-S-assign)
783
(define-key inferior-ess-mode-map [?\M--] 'ess-insert-S-assign)
784
)
785
786
787
(defun ess-dump-args-and-go (Sfunc) ; &optional buff)
788
"Dump the function name, with arguments, to a buffer for editing.
789
790
Currently, this needs to:
791
1. set the buffer to the right mode, with the right settings
792
2. format the statement,
793
3. c/function/Sfunc/
794
and I need to relearn emacs lisp (but I had to, anyway."
795
796
(interactive "sFunction ? ")
797
(let* ((buffname "ess-complete.R")
798
(buf (ess-execute (format "args(%s)" Sfunc) t buffname)))
799
(pop-to-buffer buf)
800
(message "here yet?")
801
(while (search-forward "function" nil t)
802
(replace-match Sfunc nil t))
803
(ess-setq-vars-local ess-customize-alist); (current-buffer))
804
(setq major-mode 'ess-mode)
805
(use-local-map ess-mode-map)
806
(set-syntax-table ess-mode-syntax-table)
807
))
808
809
810
811
;;; S imenu support
812
813
;; don't use syntax classes, bad for etags
814
(defvar ess-imenu-S-generic-expression
815
'(("Functions" "^\\(.+\\)[ \t\n]*<-[ \t\n]*function[ ]*(" 1)
816
("Classes" "^.*setClass(\\(.*\\)," 1)
817
("Coercions" "^.*setAs(\\([^,]+,[^,]*\\)," 1) ; show from and to
818
("Generics" "^.*setGeneric(\\([^,]*\\)," 1)
819
("Methods" "^.*set\\(Group\\|Replace\\)?Method(\\([^,]+,[^,]*\\)" 2)
820
;;[ ]*\\(signature=\\)?(\\(.*,?\\)*\\)," 1)
821
;;
822
;;("Other" "^\\(.+\\)\\s-*<-[ \t\n]*[^\\(function\\|read\\|.*data\.frame\\)]" 1)
823
("Package" "^.*\\(library\\|require\\)(\\(.*\\)" 2)
824
("Data" "^\\(.+\\)[ \t\n]-*<-[ \t\n]*\\(read\\|.*data\.frame\\).*(" 1)))
825
826
(defun ess-imenu-S (&optional arg)
827
"S Language Imenu support for ESS."
828
(interactive)
829
(setq imenu-generic-expression ess-imenu-generic-expression)
830
(imenu-add-to-menubar "Imenu-S"))
831
832
(defalias 'ess-imenu-R 'ess-imenu-S)
833
834
835
;;; Speedbar stuff.
836
(defun ess-S-initialize-speedbar ()
837
"Extend to all extensions; see initialization, and edit."
838
(speedbar-add-supported-extension ".R")
839
(speedbar-add-supported-extension ".S")
840
(speedbar-add-supported-extension ".s")
841
(speedbar-add-supported-extension ".q"))
842
843
;(if (featurep 'speedbar)
844
; (progn
845
; (message "enabling speedbar support")
846
; (require 'speedbar)
847
; (ess-S-initialize-speedbar)))
848
849
(eval-when-compile
850
(condition-case nil
851
(progn
852
(require 'speedbar)
853
(when (featurep 'speedbar)
854
(message "enabling speedbar support")
855
856
(defun S-speedbar-buttons (buffer)
857
"attempted hack."
858
859
;;(speedbar-make-tag-line)
860
;;(speedbar-insert-button)
861
(speedbar-with-writable))
862
863
(fset 'R-speedbar-buttons 'S-speedbar-buttons)
864
865
(defun S-speedbar-menu-items ( )
866
"Need to write.")
867
868
(ess-S-initialize-speedbar)))
869
(error nil)))
870
871
(provide 'ess-s-l)
872
873
; Local variables section
874
875
;;; This file is automatically placed in Outline minor mode.
876
;;; The file is structured as follows:
877
;;; Chapters: ^L ;
878
;;; Sections: ;;*;;
879
;;; Subsections: ;;;*;;;
880
;;; Components: defuns, defvars, defconsts
881
;;; Random code beginning with a ;;;;* comment
882
883
;;; Local variables:
884
;;; mode: emacs-lisp
885
;;; outline-minor-mode: nil
886
;;; mode: outline-minor
887
;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
888
;;; End:
889
890
;;; ess-s-l.el ends here
891
892