cgit.sxemacs.org Git - packages/blob - xemacs-packages/ess/lisp/essl-omg.el

   1 ;;; essl-omg.el --- Support for editing Omega source code
   2
   3 ;; Copyright (C) 1999--2001 A.J. Rossini.
   4 ;; Copyright (C) 2002--2004 A.J. Rossini, Rich M. Heiberger, Martin
   5 ;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
   6
   7 ;; Original Author: A.J. Rossini <rossini@u.washington.edu>
   8 ;; Created: 15 Aug 1999
   9 ;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>
  10
  11 ;; This file is part of ESS (Emacs Speaks Statistics).
  12
  13 ;; This file is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; This file is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  25 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; Code for general editing Omega source code.  This is initially
  30 ;; based upon the similarities between Omega and S, but will need to
  31 ;; diverge to incorporate the use of Java-style coding.
  32
  33 ;;; Code:
  34
  35 \f ; Requires and autoloads
  36
  37
  38 \f ; Specialized functions
  39
  40 (defun OMG-comment-indent ()
  41   "Indentation for Omega comments."
  42
  43   (if (looking-at "////")
  44       (current-column)
  45     (if (looking-at "///")
  46         (let ((tem (S-calculate-indent)))
  47           (if (listp tem) (car tem) tem))
  48       (skip-chars-backward " \t")
  49       (max (if (bolp) 0 (1+ (current-column)))
  50            comment-column))))
  51
  52 (defun OMG-indent-line ()
  53   "Indent current line as Omega code.
  54 Return the amount the indentation changed by."
  55   (let ((indent (S-calculate-indent nil))
  56         beg shift-amt
  57         (case-fold-search nil)
  58         (pos (- (point-max) (point))))
  59     (beginning-of-line)
  60     (setq beg (point))
  61     (cond ((eq indent nil)
  62            (setq indent (current-indentation)))
  63           (t
  64            (skip-chars-forward " \t")
  65            (if (and ess-fancy-comments (looking-at "////"))
  66                (setq indent 0))
  67            (if (and ess-fancy-comments
  68                     (looking-at "//")
  69                     (not (looking-at "///")))
  70                (setq indent comment-column)
  71              (if (eq indent t) (setq indent 0))
  72              (if (listp indent) (setq indent (car indent)))
  73              (cond ((and (looking-at "else\\b")
  74                          (not (looking-at "else\\s_")))
  75                     (setq indent (save-excursion
  76                                    (ess-backward-to-start-of-if)
  77                                    (+ ess-else-offset
  78                                       (current-indentation)))))
  79                    ((= (following-char) ?})
  80                     (setq indent
  81                           (+ indent
  82                              (- ess-close-brace-offset ess-indent-level))))
  83                    ((= (following-char) ?{)
  84                     (setq indent (+ indent ess-brace-offset)))))))
  85     (skip-chars-forward " \t")
  86     (setq shift-amt (- indent (current-column)))
  87     (if (zerop shift-amt)
  88         (if (> (- (point-max) pos) (point))
  89             (goto-char (- (point-max) pos)))
  90       (delete-region beg (point))
  91       (indent-to indent)
  92       ;; If initial point was within line's indentation,
  93       ;; position after the indentation.
  94       ;; Else stay at same point in text.
  95       (if (> (- (point-max) pos) (point))
  96           (goto-char (- (point-max) pos))))
  97     shift-amt))
  98
  99
 100 (defun OMG-calculate-indent (&optional parse-start)
 101   "Return appropriate indentation for current line as Omega code.
 102 In usual case returns an integer: the column to indent to.
 103 Returns nil if line starts inside a string, t if in a comment."
 104   (save-excursion
 105     (beginning-of-line)
 106     (let ((indent-point (point))
 107           (case-fold-search nil)
 108           state
 109           containing-sexp)
 110       (if parse-start
 111           (goto-char parse-start)
 112         (beginning-of-defun))
 113       (while (< (point) indent-point)
 114         (setq parse-start (point))
 115         (setq state (parse-partial-sexp (point) indent-point 0))
 116         (setq containing-sexp (car (cdr state))))
 117       (cond ((or (nth 3 state) (nth 4 state))
 118              ;; return nil or t if should not change this line
 119              (nth 4 state))
 120             ((null containing-sexp)
 121              ;; Line is at top level.  May be data or function definition,
 122              (beginning-of-line)
 123              (if (and (/= (following-char) ?\{)
 124                       (save-excursion
 125                         (ess-backward-to-noncomment (point-min))
 126                         (ess-continued-statement-p)))
 127                  ess-continued-statement-offset
 128                0))   ; Unless it starts a function body
 129             ((/= (char-after containing-sexp) ?{)
 130              ;; line is expression, not statement:
 131              ;; indent to just after the surrounding open.
 132              (goto-char containing-sexp)
 133              (let ((bol (save-excursion (beginning-of-line) (point))))
 134
 135                ;; modified by shiba@isac 7.3.1992
 136                (cond ((and (numberp ess-expression-offset)
 137                            (re-search-backward "[ \t]*expression[ \t]*" bol t))
 138                       ;; This regexp match every "expression".
 139                       ;; modified by shiba
 140                       ;;(forward-sexp -1)
 141                       (beginning-of-line)
 142                       (skip-chars-forward " \t")
 143                       ;; End
 144                       (+ (current-column) ess-expression-offset))
 145                      ((and (numberp ess-arg-function-offset)
 146                            (re-search-backward
 147                             "=[ \t]*\\s\"*\\(\\w\\|\\s_\\)+\\s\"*[ \t]*"
 148                             bol
 149                             t))
 150                       (forward-sexp -1)
 151                       (+ (current-column) ess-arg-function-offset))
 152                      ;; "expression" is searched before "=".
 153                      ;; End
 154
 155                      (t
 156                       (progn (goto-char (1+ containing-sexp))
 157                              (current-column))))))
 158             (t
 159              ;; Statement level.  Is it a continuation or a new statement?
 160              ;; Find previous non-comment character.
 161              (goto-char indent-point)
 162              (ess-backward-to-noncomment containing-sexp)
 163              ;; Back up over label lines, since they don't
 164              ;; affect whether our line is a continuation.
 165              (while (eq (preceding-char) ?\,)
 166                (ess-backward-to-start-of-continued-exp containing-sexp)
 167                (beginning-of-line)
 168                (ess-backward-to-noncomment containing-sexp))
 169              ;; Now we get the answer.
 170              (if (ess-continued-statement-p)
 171                  ;; This line is continuation of preceding line's statement;
 172                  ;; indent  ess-continued-statement-offset  more than the
 173                  ;; previous line of the statement.
 174                  (progn
 175                    (ess-backward-to-start-of-continued-exp containing-sexp)
 176                    (+ ess-continued-statement-offset (current-column)
 177                       (if (save-excursion (goto-char indent-point)
 178                                           (skip-chars-forward " \t")
 179                                           (eq (following-char) ?{))
 180                           ess-continued-brace-offset 0)))
 181                ;; This line starts a new statement.
 182                ;; Position following last unclosed open.
 183                (goto-char containing-sexp)
 184                ;; Is line first statement after an open-brace?
 185                (or
 186                  ;; If no, find that first statement and indent like it.
 187                  (save-excursion
 188                    (forward-char 1)
 189                    (while (progn (skip-chars-forward " \t\n")
 190                                  (looking-at "//"))
 191                      ;; Skip over comments following openbrace.
 192                      (forward-line 1))
 193                    ;; The first following code counts
 194                    ;; if it is before the line we want to indent.
 195                    (and (< (point) indent-point)
 196                         (current-column)))
 197                  ;; If no previous statement,
 198                  ;; indent it relative to line brace is on.
 199                  ;; For open brace in column zero, don't let statement
 200                  ;; start there too.  If ess-indent-level is zero,
 201                  ;; use ess-brace-offset + ess-continued-statement-offset instead.
 202                  ;; For open-braces not the first thing in a line,
 203                  ;; add in ess-brace-imaginary-offset.
 204                  (+ (if (and (bolp) (zerop ess-indent-level))
 205                         (+ ess-brace-offset ess-continued-statement-offset)
 206                       ess-indent-level)
 207                     ;; Move back over whitespace before the openbrace.
 208                     ;; If openbrace is not first nonwhite thing on the line,
 209                     ;; add the ess-brace-imaginary-offset.
 210                     (progn (skip-chars-backward " \t")
 211                            (if (bolp) 0 ess-brace-imaginary-offset))
 212                     ;; If the openbrace is preceded by a parenthesized exp,
 213                     ;; move to the beginning of that;
 214                     ;; possibly a different line
 215                     (progn
 216                       (if (eq (preceding-char) ?\))
 217                           (forward-sexp -1))
 218                       ;; Get initial indentation of the line we are on.
 219                       (current-indentation))))))))))
 220
 221
 222
 223
 224 (defvar OMG-syntax-table nil "Syntax table for Omegahat code.")
 225 (if S-syntax-table
 226     nil
 227   (setq S-syntax-table (make-syntax-table))
 228   (modify-syntax-entry ?\\ "\\" S-syntax-table)
 229   (modify-syntax-entry ?+  "."  S-syntax-table)
 230   (modify-syntax-entry ?-  "."  S-syntax-table)
 231   (modify-syntax-entry ?=  "."  S-syntax-table)
 232   (modify-syntax-entry ?%  "."  S-syntax-table)
 233   (modify-syntax-entry ?<  "."  S-syntax-table)
 234   (modify-syntax-entry ?>  "."  S-syntax-table)
 235   (modify-syntax-entry ?&  "."  S-syntax-table)
 236   (modify-syntax-entry ?|  "."  S-syntax-table)
 237   (modify-syntax-entry ?\' "\"" S-syntax-table)
 238   ;;FIXME: This fails (warning in compilation):
 239   ;;F "//" are 2 characters; ?// is invalid
 240   ;;F NEXT LINE IS BOGUS IN XEMACS, AJR
 241   ;;F (modify-syntax-entry ?//  "<"  S-syntax-table) ; open comment
 242   ;;F (modify-syntax-entry ?\n ">"  S-syntax-table) ; close comment
 243   ;;(modify-syntax-entry ?.  "w"  S-syntax-table) ; "." used in S obj names
 244   (modify-syntax-entry ?.  "_"  S-syntax-table) ; see above/below,
 245                                         ; plus consider separation.
 246   (modify-syntax-entry ?$  "_"  S-syntax-table) ; foo.bar$hack is 1 symbol
 247   (modify-syntax-entry ?_  "."  S-syntax-table)
 248   (modify-syntax-entry ?*  "."  S-syntax-table)
 249   (modify-syntax-entry ?<  "."  S-syntax-table)
 250   (modify-syntax-entry ?>  "."  S-syntax-table)
 251   (modify-syntax-entry ?/  "."  S-syntax-table))
 252
 253
 254 (defvar OMG-editing-alist
 255   '((paragraph-start              . (concat "^$\\|" page-delimiter))
 256     (paragraph-separate           . (concat "^$\\|" page-delimiter))
 257     (paragraph-ignore-fill-prefix . t)
 258     (require-final-newline        . t)
 259     (comment-start                . "//")
 260     (comment-start-skip           . "//+ *")
 261     (comment-column               . 40)
 262     ;;(comment-indent-function  . 'S-comment-indent)
 263     ;;(ess-comment-indent           . 'S-comment-indent)
 264     ;;(ess-indent-line                      . 'S-indent-line)
 265     ;;(ess-calculate-indent           . 'S-calculate-indent)
 266     (indent-line-function            . 'S-indent-line)
 267     (parse-sexp-ignore-comments   . t)
 268     (ess-set-style                . ess-default-style)
 269     (ess-local-process-name       . nil)
 270     ;;(ess-keep-dump-files          . 'ask)
 271     (ess-mode-syntax-table        . S-syntax-table)
 272     (font-lock-defaults           . '(ess-S-mode-font-lock-keywords
 273                                       nil nil ((?\. . "w")))))
 274   "General options for Omegahat source files.")
 275
 276
 277 ;;; Changes from S to S-PLUS 3.x.  (standard S3 should be in essl-s!).
 278
 279 (defconst OMG-help-sec-keys-alist
 280   '((?a . "ARGUMENTS:")
 281     (?b . "BACKGROUND:")
 282     (?B . "BUGS:")
 283     (?d . "DESCRIPTION:")
 284     (?D . "DETAILS:")
 285     (?e . "EXAMPLES:")
 286     (?n . "NOTE:")
 287     (?O . "OPTIONAL ARGUMENTS:")
 288     (?R . "REQUIRED ARGUMENTS:")
 289     (?r . "REFERENCES:")
 290     (?s . "SEE ALSO:")
 291     (?S . "SIDE EFFECTS:")
 292     (?u . "USAGE:")
 293     (?v . "VALUE:"))
 294   "Alist of (key . string) pairs for use in section searching.")
 295 ;;; `key' indicates the keystroke to use to search for the section heading
 296 ;;; `string' in an S help file. `string' is used as part of a
 297 ;;; regexp-search, and so specials should be quoted.
 298
 299 (defconst ess-help-OMG-sec-regex "^[A-Z. ---]+:$"
 300   "Reg(ular) Ex(pression) of section headers in help file")
 301
 302 ;;;    S-mode extras of Martin Maechler, Statistik, ETH Zurich.
 303
 304 ;;>> Moved things into --> ./ess-utils.el
 305
 306 ;(defvar ess-function-outline-file
 307 ;  (concat ess-lisp-directory "/../etc/" "function-outline.omg")
 308 ;  "The file name of the ess-function outline that is to be inserted at point,
 309 ;when \\<ess-mode-map>\\[ess-insert-function-outline] is used.
 310 ;Placeholders (substituted `at runtime'): $A$ for `Author', $D$ for `Date'.")
 311
 312 ;;; Use the user's own ~/S/emacs-fun.outline  is (s)he has one : ---
 313 ;(let ((outline-file (concat (getenv "HOME") "/S/function-outline.omg")))
 314 ;  (if (file-exists-p outline-file)
 315 ;      (setq ess-function-outline-file outline-file)))
 316
 317 ;(defun ess-insert-function-outline ()
 318 ;  "Insert an S function definition `outline' at point.
 319 ;Uses the file given by the variable ess-function-outline-file."
 320 ;  (interactive)
 321 ;  (let ((oldpos (point)))
 322 ;    (save-excursion
 323 ;      (insert-file-contents ess-function-outline-file)
 324 ;      (if (search-forward "$A$" nil t)
 325 ;         (replace-match (user-full-name) 'not-upcase 'literal))
 326 ;      (goto-char oldpos)
 327 ;      (if (search-forward "$D$" nil t)
 328 ;         (replace-match (ess-time-string 'clock) 'not-upcase 'literal)))
 329 ;    (goto-char (1+ oldpos))))
 330
 331 ;;;*;; S/R  Pretty-Editing
 332
 333 ;(defun ess-fix-comments (&optional dont-query verbose)
 334 ;  "Fix ess-mode buffer so that single-line comments start with at least `//'."
 335 ;  (interactive "P")
 336 ;  (save-excursion
 337 ;    (goto-char (point-min))
 338 ;    (let ((rgxp "^\\([ \t]*/\\)\\([^/]\\)")
 339 ;         (to   "\\1/\\2"))
 340 ;      (if dont-query
 341 ;         (ess-rep-regexp     rgxp to nil nil verbose)
 342 ;       (query-replace-regexp rgxp to nil)))))
 343
 344
 345 ;(defun ess-dump-to-src (&optional dont-query verbose)
 346 ;  "Make the changes in an S - dump() file to improve human readability"
 347 ;  (interactive "P")
 348 ;  (save-excursion
 349 ;    (if (not (equal major-mode 'ess-mode))
 350 ;       (ess-mode))
 351 ;    (goto-char (point-min))
 352 ;    (let ((rgxp "^\"\\([a-z.][a-z.0-9]*\\)\"<-\n")
 353 ;         (to   "\n\\1 <- "))
 354 ;      (if dont-query
 355 ;         (ess-rep-regexp     rgxp to nil nil verbose)
 356 ;       (query-replace-regexp rgxp to nil)))))
 357
 358 ;(defun ess-num-var-round (&optional dont-query verbose)
 359 ;  "Is VERY useful for dump(.)'ed numeric variables; ROUND some of them by
 360 ;  replacing  endings of 000000*.. and 999999*.  Martin Maechler"
 361 ;  (interactive "P")
 362 ;  (save-excursion
 363 ;    (goto-char (point-min))
 364
 365 ;    (let ((num 0)
 366 ;         (str "")
 367 ;         (rgxp "000000+[1-9]?[1-9]?\\>")
 368 ;         (to   ""))
 369 ;      (if dont-query
 370 ;         (ess-rep-regexp     rgxp to nil nil verbose)
 371 ;       (query-replace-regexp rgxp to nil))
 372
 373 ;      (while (< num 9)
 374 ;       (setq str (concat (int-to-string num) "999999+[0-8]*"))
 375 ;       (if (and (numberp verbose) (> verbose 1))
 376 ;           (message (format "\nregexp: '%s'" str)))
 377 ;       (goto-char (point-min))
 378 ;       (ess-rep-regexp str (int-to-string (1+ num))
 379 ;                       'fixedcase 'literal verbose)
 380 ;       (setq num (1+ num))))))
 381
 382 ;(defun ess-MM-fix-src (&optional dont-query verbose)
 383 ;  "Clean up ess-source code which has been produced by  dump(..).
 384 ; Produces more readable code, and one that is well formatted in emacs
 385 ; ess-mode. Martin Maechler, ETH Zurich."
 386 ;  (interactive "P")
 387 ;  ;; the 3 following functions each do a save-excursion:
 388 ;  (ess-dump-to-src dont-query)
 389 ;  (ess-fix-comments dont-query)
 390 ;  (ess-num-var-round dont-query verbose))
 391
 392 ;(defun ess-add-MM-keys ()
 393 ;  (require 'ess-mode)
 394 ;  (define-key ess-mode-map "\C-cf" 'ess-insert-function-outline))
 395
 396 (provide 'essl-omg)
 397
 398 \f ; Local variables section
 399
 400 ;;; This file is automatically placed in Outline minor mode.
 401 ;;; The file is structured as follows:
 402 ;;; Chapters:     ^L ;
 403 ;;; Sections:    ;;*;;
 404 ;;; Subsections: ;;;*;;;
 405 ;;; Components:  defuns, defvars, defconsts
 406 ;;;              Random code beginning with a ;;;;* comment
 407
 408 ;;; Local variables:
 409 ;;; mode: emacs-lisp
 410 ;;; outline-minor-mode: nil
 411 ;;; mode: outline-minor
 412 ;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
 413 ;;; End:
 414
 415 ;;; essl-omg.el ends here
 416