lisp/essl-s.el

   1 ;;; essl-s.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, Rich M. Heiberger, Martin
   6 ;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
   7
   8 ;; Original Author: A.J. Rossini <rossini@biostat.washington.edu>
   9 ;; Created: 26 Aug 1997
  10 ;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>
  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 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  26 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; Code for general editing S source code (specializes to S, S+, R).
  31
  32 ;;; Code:
  33
  34 \f ; Requires and autoloads
  35
  36 (ess-message "[essl-s:] (def** ) only ...")
  37
  38 \f ; Configuration variables
  39
  40 (defvar S-syntax-table nil "Syntax table for S code.")
  41 (if S-syntax-table
  42     nil
  43   (setq S-syntax-table (make-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)
  53   (modify-syntax-entry ?\' "\"" S-syntax-table)
  54   (modify-syntax-entry ?\" "\"" S-syntax-table)
  55   (modify-syntax-entry ?#  "<"  S-syntax-table) ; open comment
  56   (modify-syntax-entry ?\n ">"  S-syntax-table) ; close comment
  57   ;;(modify-syntax-entry ?.  "w"  S-syntax-table) ; "." used in S obj names
  58   (modify-syntax-entry ?.  "_"  S-syntax-table) ; see above/below,
  59                                         ; plus consider separation.
  60   (modify-syntax-entry ?$  "_"  S-syntax-table); foo$comp = 1 symbol(completion)
  61   (modify-syntax-entry ?@  "_"  S-syntax-table); foo@slot = 1 symbol(completion)
  62   (modify-syntax-entry ?_  "."  S-syntax-table)
  63   (modify-syntax-entry ?*  "."  S-syntax-table)
  64   (modify-syntax-entry ?<  "."  S-syntax-table)
  65   (modify-syntax-entry ?>  "."  S-syntax-table)
  66   (modify-syntax-entry ?/  "."  S-syntax-table))
  67
  68 (defvar R-editing-alist
  69   '((paragraph-start              . (concat "\\s-*$\\|" page-delimiter))
  70     (paragraph-separate           . (concat "\\s-*$\\|" page-delimiter))
  71     (paragraph-ignore-fill-prefix . t)
  72     (require-final-newline        . t)
  73     (comment-start                . "#")
  74     (comment-add                  . 1)
  75     (comment-start-skip           . "#+ *")
  76     (comment-column               . 40)
  77     ;;(comment-indent-function  . 'S-comment-indent)
  78     ;;(ess-comment-indent           . 'S-comment-indent)
  79     ;;(ess-indent-line                      . 'S-indent-line)
  80     ;;(ess-calculate-indent           . 'S-calculate-indent)
  81     (indent-line-function         . 'S-indent-line)
  82     (parse-sexp-ignore-comments   . t)
  83     (ess-style                    . ess-default-style)
  84     (ess-local-process-name       . nil)
  85     ;;(ess-keep-dump-files          . 'ask)
  86     (ess-mode-syntax-table        . S-syntax-table)
  87     ;; For Changelog add, require ' ' before <- : "attr<-" is a function name :
  88     (add-log-current-defun-header-regexp . "^\\(.+\\)\\s-+<-[ \t\n]*function")
  89     (font-lock-defaults           . '(ess-R-mode-font-lock-keywords
  90                                       nil nil ((?\. . "w") (?\_ . "w"))))
  91     )
  92   "General options for R source files.")
  93
  94 (defvar S-editing-alist
  95   ;; copy the R-list and modify :
  96   (let ((S-alist (copy-alist R-editing-alist)))
  97     (setcdr (assoc 'font-lock-defaults S-alist)
  98             (quote '(ess-S-mode-font-lock-keywords nil nil ((?\. . "w")))))
  99     ;;      ^^ extra quote is needed - why?
 100     S-alist)
 101   "General options for editing S and S+ source files.")
 102
 103 (defvar inferior-S-language-start
 104   '(concat "options("
 105              "STERM='"  ess-STERM  "'"
 106              (if ess-editor (concat ", editor='" ess-editor "'"))
 107              (if ess-pager  (concat ", pager='"  ess-pager  "', help.pager='"  ess-pager  "'"))
 108              ")")
 109   "S language expression for startup -- default for all S dialects.")
 110
 111 (defconst S-common-cust-alist
 112   '((ess-language                  . "S")
 113     (inferior-ess-exit-command     . "q()\n")
 114     (inferior-ess-language-start   . (eval inferior-S-language-start))
 115     ;;harmful for shell-mode's C-a: -- but "necessary" for ESS-help(?) :
 116     (comint-use-prompt-regexp-instead-of-fields . t) ;; emacs 21 and up
 117   )
 118   "S-language common settings for all <dialect>-customize-alist s"
 119 )
 120
 121 (defconst S+common-cust-alist
 122   (append
 123    '((ess-suffix                . "S")
 124      (ess-mode-syntax-table     . S-syntax-table)
 125      (ess-help-sec-regex        . ess-help-S+-sec-regex)
 126      (ess-help-sec-keys-alist   . ess-help-S+sec-keys-alist)
 127      (ess-change-sp-regexp      . ess-S+-change-sp-regexp)
 128      (ess-cmd-delay             . (if (featurep 'xemacs); needs much less delay
 129                                       (* 0.1 ess-S+-cmd-delay)
 130                                     ess-S+-cmd-delay))
 131      (ess-function-pattern      . ess-S-function-pattern)
 132      (ess-function-template     . " <- \n#\nfunction()\n{\n\n}\n")
 133      (ess-dump-filename-template . (ess-replace-regexp-in-string
 134                                     "S$" ess-suffix ; in the one from custom:
 135                                     ess-dump-filename-template-proto))
 136
 137      (ess-mode-editing-alist    . S-editing-alist)
 138
 139      (ess-dumped-missing-re
 140       . "\\(\\(<-\\|=\\)\nDumped\n\\'\\)\\|\\(\\(<-\\|=\\)\\(\\s \\|\n\\)*\\'\\)")
 141      (ess-syntax-error-re
 142       . "\\(Syntax error: .*\\) at line \\([0-9]*\\), file \\(.*\\)$")
 143      (inferior-ess-objects-command  . inferior-Splus-objects-command)
 144      (inferior-ess-font-lock-keywords . inferior-ess-S-font-lock-keywords)
 145      (inferior-ess-primary-prompt   . "[a-zA-Z0-9() ]*> ?")
 146      (inferior-ess-secondary-prompt . "+ ?")
 147
 148      (ess-editor . S-editor)
 149      (ess-pager  . S-pager)
 150      )
 151    S-common-cust-alist)
 152   "Common settings for all S+<*>-customize-alist s"
 153 )
 154
 155 ;;; Changes from S to S-PLUS 3.x.  (standard S3 should be in essl-s!).
 156
 157 (defconst ess-help-S+sec-keys-alist
 158   '((?a . "ARGUMENTS:")
 159     (?b . "BACKGROUND:")
 160     (?B . "BUGS:")
 161     (?d . "DESCRIPTION:")
 162     (?D . "DETAILS:")
 163     (?e . "EXAMPLES:")
 164     (?n . "NOTE:")
 165     (?O . "OPTIONAL ARGUMENTS:")
 166     (?R . "REQUIRED ARGUMENTS:")
 167     (?r . "REFERENCES:")
 168     (?s . "SEE ALSO:")
 169     (?S . "SIDE EFFECTS:")
 170     (?u . "USAGE:")
 171     (?v . "VALUE:"))
 172   "Alist of (key . string) pairs for use in section searching.")
 173 ;;; `key' indicates the keystroke to use to search for the section heading
 174 ;;; `string' in an S help file. `string' is used as part of a
 175 ;;; regexp-search, and so specials should be quoted.
 176
 177 ;; S ver.3 (NOT S-Plus)
 178 (defconst ess-help-S3-sec-keys-alist
 179   '((?a . "ARGUMENTS:")
 180     (?b . "BACKGROUND:")
 181     (?B . "BUGS:")
 182     (?d . "DESCRIPTION:")
 183     (?D . "DETAILS:")
 184     (?e . "EXAMPLES:")
 185     (?n . "NOTE:")
 186     (?r . "REFERENCES:")
 187     (?s . "SEE ALSO:")
 188     (?S . "SIDE EFFECTS:")
 189     (?u . "USAGE:")
 190     (?v . "VALUE:"))
 191   "Help section keys for S ver.3.")
 192
 193 ;; S ver.4 (NOT S-Plus)
 194 (defconst ess-help-S4-sec-keys-alist
 195   '((?a . "ARGUMENTS:")
 196     (?b . "BACKGROUND:")
 197     (?B . "BUGS:")
 198     (?d . "DESCRIPTION:")
 199     (?D . "DETAILS:")
 200     (?e . "EXAMPLES:")
 201     (?n . "NOTE:")
 202     (?r . "REFERENCES:")
 203     (?s . "SEE ALSO:")
 204     (?S . "SIDE EFFECTS:")
 205     (?u . "USAGE:")
 206     (?v . "VALUE:"))
 207   "Help section keys for S4.")
 208
 209 ;; R
 210 (defconst ess-help-R-sec-keys-alist
 211   '((?a . "\\s *Arguments:")
 212     (?d . "\\s *Description:")
 213     (?D . "\\s *Details:")
 214     (?e . "\\s *Examples:")
 215     (?n . "\\s *Note:")
 216     (?r . "\\s *References:")
 217     (?s . "\\s *See Also:")
 218     (?u . "\\s *Usage:")
 219     (?v . "\\s *Value[s]?")     ;
 220     )
 221   "Alist of (key . string) pairs for use in help section searching.")
 222
 223
 224 (defconst ess-help-S+-sec-regex "^[A-Z. ---]+:$"
 225   "Reg(ular) Ex(pression) of section headers in help file.")
 226
 227 (defconst ess-help-R-sec-regex "^[A-Z][a-z].+:$"
 228   "Reg(ular) Ex(pression) of section headers in help file.")
 229
 230 ;;; S-mode extras of Martin Maechler, Statistik, ETH Zurich.
 231 ;;; See also ./ess-utils.el
 232
 233 (defvar ess-function-outline-file
 234   (concat ess-etc-directory  "/function-outline.S")
 235   "The file name of the ess-function outline that is to be inserted at point,
 236 when \\[ess-insert-function-outline] is used.
 237 Placeholders (substituted `at runtime'): $A$ for `Author', $D$ for `Date'.")
 238
 239 ;; Use the user's own ~/S/emacs-fun.outline  if (s)he has one : ---
 240 (let ((outline-file (concat (getenv "HOME") "/S/function-outline.S")))
 241   (if (file-exists-p outline-file)
 242       (setq ess-function-outline-file outline-file)))
 243
 244 ;; Seth's idea; see ess-toggle-S-assign-key below
 245 (defvar ess-S-assign-key [?\C-=] ;; = "\C-c=" ; old-default:  "_"
 246   "This key is mapped to insert `ess-S-assign' (by default '<-'),
 247 when \\[ess-toggle-S-assign-key] is called.")
 248
 249 (defvar ess-S-assign-key-last nil
 250   "This caches the previous value (binding) of `ess-S-assign-key'.  It allows
 251  \\[ess-toggle-S-assign-key] to toggle back to the previous definition.")
 252
 253 \f ; Function Definitions
 254
 255 (defun S-comment-indent ()
 256   "Indentation for S comments."
 257
 258   (if (looking-at "###")
 259       (current-column)
 260     (if (looking-at "##")
 261         (let ((tem (S-calculate-indent)))
 262           (if (listp tem) (car tem) tem))
 263       (skip-chars-backward " \t")
 264       (max (if (bolp) 0 (1+ (current-column)))
 265            comment-column))))
 266
 267 (defun S-indent-line ()
 268   "Indent current line as S code.
 269 Return the amount the indentation changed by."
 270   (let ((indent (S-calculate-indent nil))
 271         beg shift-amt
 272         (case-fold-search nil)
 273         (pos (- (point-max) (point))))
 274     (beginning-of-line)
 275     (setq beg (point))
 276     (cond ((eq indent nil)
 277            (setq indent (current-indentation)))
 278           (t
 279            (skip-chars-forward " \t")
 280            (if (and ess-fancy-comments (looking-at "###"))
 281                (setq indent 0))
 282            (if (and ess-fancy-comments
 283                     (looking-at "#")
 284                     (not (looking-at "##")))
 285                (setq indent comment-column)
 286              (if (eq indent t) (setq indent 0))
 287              (if (listp indent) (setq indent (car indent)))
 288              (cond ((and (looking-at "else\\b")
 289                          (not (looking-at "else\\s_")))
 290                     (setq indent (save-excursion
 291                                    (ess-backward-to-start-of-if)
 292                                    (+ ess-else-offset (current-indentation)))))
 293                    ((= (following-char) ?})
 294                     (setq indent
 295                           (+ indent
 296                              (- ess-close-brace-offset ess-indent-level))))
 297                    ((= (following-char) ?{)
 298                     (setq indent (+ indent ess-brace-offset)))))))
 299     (skip-chars-forward " \t")
 300     (setq shift-amt (- indent (current-column)))
 301     (if (zerop shift-amt)
 302         (if (> (- (point-max) pos) (point))
 303             (goto-char (- (point-max) pos)))
 304       (delete-region beg (point))
 305       (indent-to indent)
 306       ;; If initial point was within line's indentation,
 307       ;; position after the indentation.
 308       ;; Else stay at same point in text.
 309       (if (> (- (point-max) pos) (point))
 310           (goto-char (- (point-max) pos))))
 311     shift-amt))
 312
 313 (defun S-calculate-indent (&optional parse-start)
 314   "Return appropriate indentation for current line as S code.
 315 In usual case returns an integer: the column to indent to.
 316 Returns nil if line starts inside a string, t if in a comment."
 317   (save-excursion
 318     (beginning-of-line)
 319     (let ((indent-point (point))
 320           (case-fold-search nil)
 321           state
 322           containing-sexp)
 323       (if parse-start
 324           (goto-char parse-start)
 325         (beginning-of-defun))
 326       (while (< (point) indent-point)
 327         (setq parse-start (point))
 328         (setq state (parse-partial-sexp (point) indent-point 0))
 329         (setq containing-sexp (car (cdr state))))
 330       (cond ((or (nth 3 state) (nth 4 state))
 331              ;; return nil or t if should not change this line
 332              (nth 4 state))
 333             ((null containing-sexp)
 334              ;; Line is at top level.  May be data or function definition,
 335              (beginning-of-line)
 336              (if (and (/= (following-char) ?\{)
 337                       (save-excursion
 338                         (ess-backward-to-noncomment (point-min))
 339                         (ess-continued-statement-p)))
 340                  ess-continued-statement-offset
 341                0))   ; Unless it starts a function body
 342             ((/= (char-after containing-sexp) ?{)
 343              ;; line is expression, not statement:
 344              ;; indent to just after the surrounding open.
 345              (goto-char containing-sexp)
 346              (let ((bol (save-excursion (beginning-of-line) (point))))
 347
 348                ;; modified by shiba@isac 7.3.1992
 349                (cond ((and (numberp ess-expression-offset)
 350                            (re-search-backward "[ \t]*expression[ \t]*" bol t))
 351                       ;; This regexp match every "expression".
 352                       ;; modified by shiba
 353                       ;;(forward-sexp -1)
 354                       (beginning-of-line)
 355                       (skip-chars-forward " \t")
 356                       ;; End
 357                       (+ (current-column) ess-expression-offset))
 358                      ((and (numberp ess-arg-function-offset)
 359                            (re-search-backward
 360                             "=[ \t]*\\s\"?\\(\\w\\|\\s_\\)+\\s\"?[ \t]*"
 361                             bol
 362                             t))
 363                       (forward-sexp -1)
 364                       (+ (current-column) ess-arg-function-offset))
 365                      ;; "expression" is searched before "=".
 366                      ;; End
 367
 368                      (t
 369                       (progn (goto-char (1+ containing-sexp))
 370                              (current-column))))))
 371             (t
 372              ;; Statement level.  Is it a continuation or a new statement?
 373              ;; Find previous non-comment character.
 374              (goto-char indent-point)
 375              (ess-backward-to-noncomment containing-sexp)
 376              ;; Back up over label lines, since they don't
 377              ;; affect whether our line is a continuation.
 378              (while (eq (preceding-char) ?\,)
 379                (ess-backward-to-start-of-continued-exp containing-sexp)
 380                (beginning-of-line)
 381                (ess-backward-to-noncomment containing-sexp))
 382              ;; Now we get the answer.
 383              (if (ess-continued-statement-p)
 384                  ;; This line is continuation of preceding line's statement;
 385                  ;; indent  ess-continued-statement-offset  more than the
 386                  ;; previous line of the statement.
 387                  (progn
 388                    (ess-backward-to-start-of-continued-exp containing-sexp)
 389                    (+ ess-continued-statement-offset (current-column)
 390                       (if (save-excursion (goto-char indent-point)
 391                                           (skip-chars-forward " \t")
 392                                           (eq (following-char) ?{))
 393                           ess-continued-brace-offset 0)))
 394                ;; This line starts a new statement.
 395                ;; Position following last unclosed open.
 396                (goto-char containing-sexp)
 397                ;; Is line first statement after an open-brace?
 398                (or
 399                  ;; If no, find that first statement and indent like it.
 400                  (save-excursion
 401                    (forward-char 1)
 402                    (while (progn (skip-chars-forward " \t\n")
 403                                  (looking-at "#"))
 404                      ;; Skip over comments following openbrace.
 405                      (forward-line 1))
 406                    ;; The first following code counts
 407                    ;; if it is before the line we want to indent.
 408                    (and (< (point) indent-point)
 409                         (current-column)))
 410                  ;; If no previous statement,
 411                  ;; indent it relative to line brace is on.
 412                  ;; For open brace in column zero, don't let statement
 413                  ;; start there too.  If ess-indent-level is zero, use
 414                  ;; ess-brace-offset + ess-continued-statement-offset
 415                  ;; instead.
 416                  ;; For open-braces not the first thing in a line,
 417                  ;; add in ess-brace-imaginary-offset.
 418                  (+ (if (and (bolp) (zerop ess-indent-level))
 419                         (+ ess-brace-offset ess-continued-statement-offset)
 420                       ess-indent-level)
 421                     ;; Move back over whitespace before the openbrace.
 422                     ;; If openbrace is not first nonwhite thing on the line,
 423                     ;; add the ess-brace-imaginary-offset.
 424                     (progn (skip-chars-backward " \t")
 425                            (if (bolp) 0 ess-brace-imaginary-offset))
 426                     ;; If the openbrace is preceded by a parenthesized exp,
 427                     ;; move to the beginning of that;
 428                     ;; possibly a different line
 429                     (progn
 430                       (if (eq (preceding-char) ?\))
 431                           (forward-sexp -1))
 432                       ;; Get initial indentation of the line we are on.
 433                       (current-indentation))))))))))
 434
 435 (defun ess-insert-function-outline ()
 436   "Insert an S function definition `outline' at point.
 437 Uses the file given by the variable `ess-function-outline-file'."
 438   (interactive)
 439   (let ((oldpos (point)))
 440     (save-excursion
 441       (insert-file-contents ess-function-outline-file)
 442       (if (search-forward "$A$" nil t)
 443           (replace-match (user-full-name) 'not-upcase 'literal))
 444       (goto-char oldpos)
 445       (if (search-forward "$D$" nil t)
 446           (replace-match (ess-time-string 'clock) 'not-upcase 'literal)))
 447     (goto-char (1+ oldpos))))
 448
 449 ;;*;; S/R  Pretty-Editing
 450
 451 (defun ess-fix-comments (&optional dont-query verbose)
 452   "Fix ess-mode buffer so that single-line comments start with at least `##'."
 453   (interactive "P")
 454   (ess-replace-regexp-dump-to-src "^\\([ \t]*#\\)\\([^#]\\)"
 455                                   "\\1#\\2" dont-query verbose))
 456
 457 (defun ess-dump-to-src (&optional dont-query verbose)
 458   "Make the changes in an S - dump() file to improve human readability."
 459   (interactive "P")
 460   (ess-replace-regexp-dump-to-src  "^\"\\([a-z.][a-z.0-9]*\\)\" *<-\n"
 461                                    "\n\\1 <- "
 462                                    dont-query verbose 'ensure-ess))
 463
 464 (defun ess-num-var-round (&optional dont-query verbose)
 465   "Is VERY useful for dump(.)'ed numeric variables; ROUND some of them by
 466   replacing  endings of 000000*.. and 999999*.  Martin Maechler"
 467   (interactive "P")
 468   (save-excursion
 469     (goto-char (point-min))
 470
 471     (let ((num 0)
 472           (str "")
 473           (rgxp "000000+[1-9]?[1-9]?\\>")
 474           (to   ""))
 475       (if dont-query
 476           (ess-rep-regexp     rgxp to nil nil verbose)
 477         (query-replace-regexp rgxp to nil))
 478
 479       (while (< num 9)
 480         (setq str (concat (int-to-string num) "999999+[0-8]*"))
 481         (if (and (numberp verbose) (> verbose 1))
 482             (message (format "\nregexp: '%s'" str)))
 483         (goto-char (point-min))
 484         (ess-rep-regexp str (int-to-string (1+ num))
 485                         'fixedcase 'literal verbose)
 486         (setq num (1+ num))))))
 487
 488 (defun ess-fix-dot (before-chars &optional dont-query verbose)
 489   "Remove trailing decimal '.' (\"dot\"), before BEFORE; typically from S-plus"
 490   ;; typically, before-chars =  "]:" or more
 491   (ess-replace-regexp-dump-to-src
 492    (concat "\\([0-9]\\)\\.\\( *[" before-chars "]\\)")
 493    ;;           111      ^
 494    "\\1\\2" dont-query verbose))
 495
 496 (defun ess-fix-dot-1 (&optional do-query verbose)
 497   "Remove trailing decimal '.' (\"dot\"), before ':' or ']', i.e.,
 498 in cases where it's ugly and nonsense.  DO-QUERY(prefix) asks before replacing."
 499   (interactive "P")
 500   (ess-fix-dot "]:" (not do-query) verbose))
 501
 502 (defun ess-fix-dot-more (&optional dont-query verbose)
 503   "Remove trailing decimal '.' (\"dot\", typically from S+) in more cases
 504  than `ess-fix-dot-1'."
 505   (interactive "P")
 506   (ess-fix-dot-1 nil verbose)
 507   (ess-fix-dot ",)" dont-query verbose))
 508
 509 (defun ess-fix-EQ-assign (&optional dont-query verbose not-all)
 510   "Replace \"=\" by \"<-\" in places where it 'might make sense', e.g.,
 511 for function assignments and lines not ending in \",\".
 512 Be *careful* for list()s of functions and when argument not-all is
 513 nil (as by default) !"
 514   ;;TODO: "in the few places we can be very sure.."
 515   ;;---- is hard in general: local functions: ok; but functions in
 516   ;;  list(a = function(x) abs(x), b= function(y) bound(y))  *NOT* ok!
 517   (interactive "P")
 518   (ess-replace-regexp-dump-to-src
 519    "^\\( *[a-z.][_a-z.0-9]*\\) *= *\\(function *(\\)"
 520    "\\1 <- \\2" dont-query verbose)
 521
 522   (unless not-all
 523     ;; "too" aggressive {proposing to replace function argument specs}:
 524     (ess-replace-regexp-dump-to-src ;; all those *not* ending in ","
 525      ;; including  Mat[ i, ] = ...,
 526      ;; but not `names(x) = "..."' for that is "confused" with plot(x=x,..)
 527      "^\\( *[a-z.][][, \"_a-z.0-9]*\\) *= *\\([a-z.0-9({]\\(.*[^,]\\)? *$\\)"
 528      "\\1 <- \\2" nil ;; always query - often has many "false positives"
 529      verbose)
 530     ))
 531
 532 ;;; All of the above three :
 533 (defun ess-MM-fix-src (&optional dont-query verbose)
 534   "Clean up ess-source code which has been produced by dump(..), and other
 535 code typically produced by other tools.  Produces more readable code,
 536 and one that is well formatted in emacs ess-mode."
 537   (interactive "P")
 538   ;; each of the following does a save-excursion:
 539   (ess-dump-to-src dont-query)
 540   (ess-fix-comments dont-query)
 541   (ess-num-var-round dont-query verbose)
 542   (ess-fix-dot-more dont-query verbose)
 543   (ess-fix-EQ-assign dont-query verbose 'not-all)
 544   )
 545
 546 (defun ess-fix-miscellaneous (&optional from verbose)
 547   "Fix Miscellaneous S/R `ill-formation's from current \\[point].
 548  Particularly use \"<-\"and put spaces around operators."
 549   (interactive "d\nP"); Defaults: point and prefix (C-u)
 550   (save-excursion
 551
 552     (if (string= ess-dialect "R")
 553         (progn
 554          (require 'essd-r)
 555          (R-fix-T-F from (not verbose))))
 556
 557     ;; former C and matlab programmers leave trailing  ";" :
 558     (goto-char from) (ess-rep-regexp "; *$" "" nil 'literal verbose)
 559     (goto-char from) (ess-rep-regexp ";\\( *\\)#" "\\1#" nil 'literal verbose)
 560
 561     ;;from R 1.9.x "_" is valid in names; here assume no initial / trailing '_'
 562     (goto-char from) (ess-rep-regexp " +_ *" " <- " nil 'literal verbose)
 563     (goto-char from) (ess-rep-regexp   "_ +" " <- " nil 'literal verbose)
 564
 565     ;; ensure space around  "<-"  ---- but only replace if necessary:
 566     (goto-char from)
 567     (ess-rep-regexp "\\([^< \t\n]\\)\\(<<?-\\)" "\\1 \\2" nil nil verbose)
 568     (goto-char from)(ess-rep-regexp "<-\\([^ \t\n]\\)" "<- \\1" nil nil verbose)
 569     ;; ensure space around  "<" (not in "<-","<=","<<-")  and ">" (not ">=") :
 570     (goto-char from);; --> " <", care with "->":
 571     (ess-rep-regexp "\\([^-< \t\n]\\)\\([<>]\\)" "\\1 \\2" nil nil verbose)
 572     ;; ">" -> "> " , for "<", don't split "<-" nor "<<-":
 573     (goto-char from)
 574     (ess-rep-regexp "\\(>=?\\)\\([^= \t\n]\\)" "\\1 \\2" nil nil verbose)
 575     (goto-char from)
 576     (ess-rep-regexp "\\(<=?\\)\\([^-<= \t\n]\\)" "\\1 \\2" nil nil t)
 577
 578     ;; -- ensure space around "=", "==", "!=" :
 579     (goto-char from) ;; --> " ="
 580     (ess-rep-regexp "\\([^=!<> ]\\)\\([=!]?\\)=" "\\1 \\2=" nil nil verbose)
 581     (goto-char from) (ess-rep-regexp "=\\([^= ]\\)" "= \\1" nil nil verbose)
 582
 583     (goto-char from) ;; add a space between "{" and surrounding ..char:
 584     (ess-rep-regexp "{\\([.A-Za-z()]\\)" "{ \\1" 'fix nil verbose)
 585     (ess-rep-regexp "\\([()]\\){" "\\1 {" 'fix nil verbose)
 586     (goto-char from) ;; add a space between "}" and a preceding wordchar:
 587     (ess-rep-regexp "\\([A-Za-z0-9()]\\)}" "\\1 }" 'fix nil verbose)
 588     (ess-space-around "else" from verbose)
 589
 590     ;; add a newline and indent before a "}"
 591     ;; --- IFF there's NO "{" or "#" AND some NON-white text on the same line:
 592     ;;D (if verbose (message "\t R-fix-misc..: Hard.. '}'"))
 593     (goto-char from)
 594     (ess-rep-regexp "^\\([^#{\n]*[^#{ \t\n]+[ \t]*\\)}[ \t]*$"
 595                      "\\1\n}" 'fix nil verbose)
 596     ))
 597
 598 ;; This is by Seth Falcon, modeled after ess-toggle-underscore (see below).
 599 (defun ess-toggle-S-assign-key (force)
 600   "Possibly bind the key in `ess-S-assign-key' to inserting `ess-S-assign'.
 601 If `ess-S-assign-key' is \"_\", simply use \\[ess-toggle-underscore].
 602 Otherwise, unless the prefix argument FORCE is set,
 603 toggle between the new and the previous assignment."
 604   (interactive "P")
 605   (require 'ess-mode)
 606   (require 'ess-inf)
 607   (let ((current-action (lookup-key ess-mode-map ess-S-assign-key))
 608         (insert-S-assign #'(lambda() (interactive)
 609                              (delete-horizontal-space) (insert ess-S-assign))))
 610     (if (and (stringp ess-S-assign-key)
 611              (string= ess-S-assign-key "_"))
 612         (ess-toggle-underscore force)
 613       ;; else "do things here"
 614       (let* ((current-is-S-assign (eq current-action insert-S-assign))
 615              (new-action (if force insert-S-assign
 616                            ;; else "not force" (default):
 617                            (if (or current-is-S-assign
 618                                    (eq ess-S-assign-key-last insert-S-assign))
 619                                ess-S-assign-key-last
 620                              insert-S-assign))))
 621         (message "[ess-toggle-S-assign-key:] current: '%s', new: '%s'"
 622                  current-action new-action)
 623         (define-key ess-mode-map          ess-S-assign-key new-action)
 624         (define-key inferior-ess-mode-map ess-S-assign-key new-action)
 625         (if (not (and force current-is-S-assign))
 626             (setq ess-S-assign-key-last current-action))))))
 627
 628 (defun ess-smart-underscore ()
 629   "Smart \"_\" key: insert `ess-S-assign', unless in string/comment.
 630 If the underscore key is pressed a second time, the assignment
 631 operator is removed and replaced by the underscore.  `ess-S-assign',
 632 typically \" <- \", can be customized.  In ESS modes other than R/S,
 633 an underscore is always inserted. "
 634   (interactive)
 635   ;;(insert (if (ess-inside-string-or-comment-p (point)) "_" ess-S-assign))
 636   (if (or
 637        (ess-inside-string-or-comment-p (point))
 638        (not (equal ess-language "S")))
 639       (insert "_")
 640     ;; Else one keypress produces ess-S-assign; a second keypress will delete
 641     ;; ess-S-assign and instead insert _
 642     ;; Rather than trying to count a second _ keypress, just check whether
 643     ;; the current point is preceded by ess-S-assign.
 644     (let ((assign-len (length ess-S-assign)))
 645       (if (and
 646            (>= (point) (+ assign-len (point-min))) ;check that we can move back
 647            (save-excursion
 648              (backward-char assign-len)
 649              (looking-at ess-S-assign)))
 650           ;; If we are currently looking at ess-S-assign, replace it with _
 651           (progn
 652             (delete-backward-char assign-len)
 653             (insert "_"))
 654         (delete-horizontal-space)
 655         (insert ess-S-assign)))))
 656
 657 (defun ess-toggle-underscore (force)
 658   "Set the \"_\" (underscore) key to \\[ess-smart-underscore] or back to \"_\".
 659  Toggle the current definition, unless FORCE is non-nil, where
 660  \\[ess-smart-underscore] is set unconditionally.
 661
 662  Using \"C-q _\" will always just insert the underscore character."
 663   (interactive "P")
 664   (require 'ess-mode)
 665   (require 'ess-inf)
 666   (let ((current-key (lookup-key ess-mode-map "_")))
 667     (if (and current-key
 668              ;; (stringp current-key) (string= current-key ess-S-assign)
 669              (not force))
 670         (progn
 671          (define-key ess-mode-map          "_" nil); 'self-insert-command
 672          (define-key inferior-ess-mode-map "_" nil))
 673       ;; else : "force" or current-key is "nil", i.e. default
 674       (define-key ess-mode-map          "_" 'ess-smart-underscore)
 675       (define-key inferior-ess-mode-map "_" 'ess-smart-underscore))))
 676
 677 ;; NOTA BENE: "_" is smart *by default* :
 678 ;; -----  The user can always customize `ess-S-assign' ...
 679 (ess-toggle-underscore 'force-to-S-assign)
 680
 681 (defun ess-add-MM-keys ()
 682   "Define MM's user keys, currently \\<ess-mode-map>\\[ess-insert-function-outline], and
 683  \\<inferior-ess-mode-map>\\[ess-execute-screen-options]."
 684   (interactive)
 685   (require 'ess-mode); typically unnecessary
 686   (require 'ess-inf); dito
 687   (define-key ess-mode-map          "\C-cf" 'ess-insert-function-outline)
 688   (define-key inferior-ess-mode-map "\C-cw" 'ess-execute-screen-options)
 689   )
 690
 691
 692 (defun ess-dump-args-and-go (Sfunc) ; &optional buff)
 693   "Dump the function name, with arguments, to a buffer for editing.
 694
 695 Currently, this needs to:
 696    1. set the buffer to the right mode, with the right settings
 697    2. format the statement,
 698    3. c/function/Sfunc/
 699 and I need to relearn emacs lisp (but I had to, anyway."
 700
 701   (interactive "sFunction ? ")
 702   (let* ((buffname "ess-complete.R")
 703          (buf (ess-execute (format "args(%s)" Sfunc) t buffname)))
 704     (pop-to-buffer buf)
 705     (message "here yet?")
 706     (while (search-forward "function" nil t)
 707       (replace-match Sfunc nil t))
 708     (ess-setq-vars-local ess-customize-alist); (current-buffer))
 709     (setq major-mode 'ess-mode)
 710     (use-local-map ess-mode-map)
 711     (set-syntax-table ess-mode-syntax-table)
 712     ))
 713
 714 (add-hook 'ess-mode-hook
 715           (lambda ()
 716             (set (make-local-variable 'fill-nobreak-predicate)
 717                  'ess-inside-string-p)
 718             (set (make-local-variable 'normal-auto-fill-function)
 719                  'ess-do-auto-fill)))
 720
 721 (provide 'essl-s)
 722
 723 \f ; Local variables section
 724
 725 ;;; This file is automatically placed in Outline minor mode.
 726 ;;; The file is structured as follows:
 727 ;;; Chapters:     ^L ;
 728 ;;; Sections:    ;;*;;
 729 ;;; Subsections: ;;;*;;;
 730 ;;; Components:  defuns, defvars, defconsts
 731 ;;;              Random code beginning with a ;;;;* comment
 732
 733 ;;; Local variables:
 734 ;;; mode: emacs-lisp
 735 ;;; outline-minor-mode: nil
 736 ;;; mode: outline-minor
 737 ;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
 738 ;;; End:
 739
 740 ;;; essl-s.el ends here
 741