← Back to branch summary

~ubuntu-branches/ubuntu/raring/ess/raring-proposed

« back to all changes in this revision

Viewing changes to lisp/ess-s4-d.el

  • Committer: Package Import Robot
  • Author(s): Dirk Eddelbuettel
  • Date: 2012-05-09 08:00:38 UTC
  • mfrom: (1.2.23)
  • Revision ID: package-import@ubuntu.com-20120509080038-7an3nhbtgaj02a17
Tags: 12.04-1-1
New upstream patch version released today

Show diffs side-by-side

added added

removed removed

Lines of Context:
lisp/ess-s4-d.el
1
1
;;; ess-s4-d.el --- S4 customization
2
2
 
3
3
;; Copyright (C) 1997--2004 A.J. Rossini, Rich M. Heiberger, Martin
4
 
;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
 
4
;;      Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
5
5
 
6
 
;; Original Author: A.J. Rossini <rossini@stat.sc.edu>
 
6
;; Author: A.J. Rossini <rossini@stat.sc.edu>
7
7
;; Created: 12 Jun 1997
8
 
;; Maintainers: ESS-core <ESS-core@r-project.org>
 
8
;; Maintainer: ESS-core <ESS-core@r-project.org>
9
9
 
10
 
;; Keywords: start up, configuration.
 
10
;; Keywords: languages
11
11
 
12
12
;; This file is part of ESS.
13
13
 
26
26
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
27
27
 
28
28
;;; Commentary:
29
 
;;; DB contributed the changes from ess-s3-d.el to
30
 
;;; ess-s4-d.el (removed the old ugly approach).
31
 
;;; This file defines S4 customizations for ess-mode.  Lots of thanks
32
 
;;; to RMH and JMC for code and suggestions
33
 
 
34
 
;;; Autoloads:
 
29
 
 
30
;; DB contributed the changes from ess-s3-d.el to
 
31
;; ess-s4-d.el (removed the old ugly approach).
 
32
;; This file defines S4 customizations for ess-mode.  Lots of thanks
 
33
;; to RMH and JMC for code and suggestions
 
34
 
 
35
;;; Code:
 
36
 
 
37
(autoload 'inferior-ess "ess-inf" "Run an ESS process.")
35
38
 
36
39
(require 'ess-s-l)
37
40
 
38
 
(autoload 'inferior-ess "ess-inf" "Run an ESS process.")
39
 
 
40
 
;;; Code:
41
 
 
42
41
;; Some of this is based on files from:
43
42
;;     Copyright (C) 1996, John M. Chambers.
44
43
 
45
44
(defvar S4-customize-alist
46
45
  (append
47
 
   '((ess-local-customize-alist         . 'S4-customize-alist)
48
 
     (ess-dialect                       . "S4")
49
 
     (ess-loop-timeout                  . ess-S-loop-timeout);fixme: dialect spec.
50
 
     (ess-change-sp-regexp              . ess-S-change-sp-regexp)
51
 
     (ess-help-sec-keys-alist           . ess-help-S3-sec-keys-alist)
52
 
     (ess-object-name-db-file           . "ess-s4-namedb.el")
53
 
     (inferior-ess-program              . inferior-S4-program-name)
54
 
     (inferior-ess-objects-command      . ".SmodeObs(%d, pattern=\"%s\")\n")
55
 
     ;;(inferior-ess-objects-pattern    . ".*") ; for new s4 stuff
56
 
     (inferior-ess-help-command         . "help(\"%s\")\n")
 
46
   '((ess-local-customize-alist         . 'S4-customize-alist)
 
47
     (ess-dialect                       . "S4")
 
48
     (ess-loop-timeout                  . ess-S-loop-timeout);fixme: dialect spec.
 
49
     (ess-change-sp-regexp              . ess-S-change-sp-regexp)
 
50
     (ess-help-sec-keys-alist           . ess-help-S3-sec-keys-alist)
 
51
     (ess-object-name-db-file           . "ess-s4-namedb.el")
 
52
     (inferior-ess-program              . inferior-S4-program-name)
 
53
     (inferior-ess-objects-command      . ".SmodeObs(%d, pattern=\"%s\")\n")
 
54
     ;;(inferior-ess-objects-pattern    . ".*") ; for new s4 stuff
 
55
     (inferior-ess-help-command         . "help(\"%s\")\n")
57
56
     (inferior-ess-help-filetype . nil)
58
 
     (inferior-ess-search-list-command  . ".SmodePaths()\n")
59
 
     (inferior-ess-load-command         . ".SmodeLoad(\"%s\")\n")
60
 
     (inferior-ess-dump-command         . ".SmodeDump(\"%s\", \"%s\")\n")
 
57
     (inferior-ess-search-list-command  . ".SmodePaths()\n")
 
58
     (inferior-ess-load-command         . ".SmodeLoad(\"%s\")\n")
 
59
     (inferior-ess-dump-command         . ".SmodeDump(\"%s\", \"%s\")\n")
61
60
 
62
 
     (inferior-ess-start-file           . nil) ;"~/.ess-S3")
 
61
     (inferior-ess-start-file           . nil) ;"~/.ess-S3")
63
62
     (inferior-ess-start-args       . "")
64
63
     (ess-STERM  . "iESS")
65
64
     )
69
68
 
70
69
;; For loading up the S code required for the above.
71
70
;;(add-hook 'ess-post-run-hook
72
 
;;         (lambda ()
73
 
;;           (ess-command
74
 
;;            (concat
75
 
;;             "if(exists(\"Sversion\")) library(emacs) else source(\""
76
 
;;             ess-mode-run-file
77
 
;;             "\")\n"))
78
 
;;           (if ess-mode-run-file2
79
 
;;               (ess-command
80
 
;;                (concat "source(\"" ess-mode-run-file2 "\")\n")))))
 
71
;;         (lambda ()
 
72
;;           (ess-command
 
73
;;            (concat
 
74
;;             "if(exists(\"Sversion\")) library(emacs) else source(\""
 
75
;;             ess-mode-run-file
 
76
;;             "\")\n"))
 
77
;;           (if ess-mode-run-file2
 
78
;;               (ess-command
 
79
;;                (concat "source(\"" ess-mode-run-file2 "\")\n")))))
81
80
 
82
81
 
83
82
(defun S4 ()
119
118
;;; S-help.file line 270
120
119
;;(defun S-get-help-files-list nil
121
120
;;  (mapcar 'list
122
 
;;        (apply 'append
123
 
;;               (mapcar (lambda (dirname)
124
 
;;                         (if (file-directory-p dirname)
125
 
;;                             (directory-files dirname)))
126
 
;;                       (mapcar (lambda (str) (concat str "/__Help"))
127
 
;;                               (S-search-list))))))
 
121
;;        (apply 'append
 
122
;;               (mapcar (lambda (dirname)
 
123
;;                         (if (file-directory-p dirname)
 
124
;;                             (directory-files dirname)))
 
125
;;                       (mapcar (lambda (str) (concat str "/__Help"))
 
126
;;                               (S-search-list))))))
128
127
;;
129
128
;;
130
129
;;;;; additional font-lock-keywords for S4
131
130
;;
132
131
;;;;*;; based on S-inf.el line 107
133
132
;;;;(add-to-list 'S-inf-font-lock-keywords
134
 
;;;;         '("\\<\\(^Problem\\|^Warning\\|^Error\\|Debug ?\\|Browsing in frame of\\|Local Variables\\)\\>" . font-lock-reference-face) ; S-inf problems
 
133
;;;;         '("\\<\\(^Problem\\|^Warning\\|^Error\\|Debug ?\\|Browsing in frame of\\|Local Variables\\)\\>" . font-lock-reference-face) ; S-inf problems
135
134
;;;;)
136
135
;;;;(add-to-list 'S-inf-font-lock-keywords
137
 
;;;; '("^R>" . font-lock-keyword-face)  ; debug prompt
 
136
;;;; '("^R>" . font-lock-keyword-face)  ; debug prompt
138
137
;;;;)
139
138
;;(inferior-S-mode)
140
139
;;
149
148
;;                                             ;; Must follow S-mode
150
149
;;;;*;; based on S-mode.el line 219
151
150
;;(add-to-list 'S-mode-font-lock-keywords
152
 
;;           '("\\<\\(setGeneric\\|removeGeneric\\|setMethod\\|unsetMethod\\|setReplaceGeneric\\|setReplaceMethod\\|standardGeneric\\|setIs\\|setClass\\|representation\\)\\>" . font-lock-function-name-face)  ; S4 method functions
 
151
;;           '("\\<\\(setGeneric\\|removeGeneric\\|setMethod\\|unsetMethod\\|setReplaceGeneric\\|setReplaceMethod\\|standardGeneric\\|setIs\\|setClass\\|representation\\)\\>" . font-lock-function-name-face)  ; S4 method functions
153
152
;;)
154
153
;;
155
154
;;
178
177
;;         (sprocess (get-S-process S-current-process-name))
179
178
;;         (sbuffer (process-buffer sprocess))
180
179
;;         r
181
 
;;       (timeout 0))
 
180
;;       (timeout 0))
182
181
;;    (set-buffer sbuffer)
183
182
;;    (while (progn
184
 
;;           (if (not (eq (process-status sprocess) 'run))
185
 
;;               (S-error "S process has died unexpectedly.")
186
 
;;             (if (> (setq timeout (1+ timeout)) S-loop-timeout)
187
 
;;                 (S-error "Timeout waiting for prompt. Check inferior-S-prompt or S-loop-timeout."))
188
 
;;             (accept-process-output)
189
 
;;             (goto-char (point-max))
 
183
;;           (if (not (eq (process-status sprocess) 'run))
 
184
;;               (S-error "S process has died unexpectedly.")
 
185
;;             (if (> (setq timeout (1+ timeout)) S-loop-timeout)
 
186
;;                 (S-error "Timeout waiting for prompt. Check inferior-S-prompt or S-loop-timeout."))
 
187
;;             (accept-process-output)
 
188
;;             (goto-char (point-max))
190
189
;;(setq end (point))
191
 
;;             (beginning-of-line)
 
190
;;             (beginning-of-line)
192
191
;;(setq e (buffer-substring (point) end))
193
192
;;(if (equal e inferior-S-debug-prompt)
194
193
;;    (S-error "Debug prompt"))
195
 
;;             (setq r (looking-at inferior-S-prompt))
196
 
;;             (not (or r (looking-at ".*\\?\\s *"))))))
 
194
;;             (setq r (looking-at inferior-S-prompt))
 
195
;;             (not (or r (looking-at ".*\\?\\s *"))))))
197
196
;;    (goto-char (point-max))
198
197
;;    (set-buffer cbuffer)
199
198
;;    (symbol-value r)))
216
215
;;      (goto-char (point-max))
217
216
;;      (if
218
217
;;          (re-search-backward ", file \"" nil t)
219
 
;;        (let* ((beg-pos (progn (re-search-forward "\"" nil t) (point)))
220
 
;;               (end-pos (progn (re-search-forward "\"" nil t) (- (point) 1)))
221
 
;;               (filename (buffer-substring beg-pos end-pos))
 
218
;;        (let* ((beg-pos (progn (re-search-forward "\"" nil t) (point)))
 
219
;;               (end-pos (progn (re-search-forward "\"" nil t) (- (point) 1)))
 
220
;;               (filename (buffer-substring beg-pos end-pos))
222
221
;;                 (fbuffer (get-file-buffer filename))
223
222
;;                 (linenum (string-to-number
224
 
;;                         (progn (re-search-backward "," nil t)
225
 
;;                                (current-word))))
226
 
;;               (end-pos (point))
 
223
;;                         (progn (re-search-backward "," nil t)
 
224
;;                                (current-word))))
 
225
;;               (end-pos (point))
227
226
;;                 (beg-pos (progn (goto-char (point-min))
228
 
;;                               (re-search-forward ":" nil t)
229
 
;;                               (1+ (point))))
 
227
;;                               (re-search-forward ":" nil t)
 
228
;;                               (1+ (point))))
230
229
;;                 (errmess (buffer-substring beg-pos end-pos))
231
 
;;               )
 
230
;;               )
232
231
;;            (if showerr
233
232
;;                  (S-display-temp-buffer errbuff)
234
233
;;              (if fbuffer nil
251
250
;;  (if start-of-output nil (setq start-of-output (point-min)))
252
251
;;  (save-excursion
253
252
;;    (while (progn
254
 
;;           ;; get output if there is some ready
255
 
;;           (accept-process-output proc 0 500)
256
 
;;           (goto-char (marker-position (process-mark proc)))
257
 
;;           (beginning-of-line)
258
 
;;
259
 
;;           (if (re-search-forward inferior-S-debug-prompt nil t)
260
 
;;               (if (equal (get-buffer S-error-buffer-name)
261
 
;;                          (get-buffer S-error-buffer-name))
262
 
;;                   (let* ((sprocess (get-S-process S-current-process-name))
263
 
;;                          (sbuffer (process-buffer sprocess)))
264
 
;;                     (set-buffer sbuffer)
265
 
;;                     (process-send-string sprocess "n\n")
266
 
;;                     (accept-process-output sprocess)
267
 
;;                     (beginning-of-line); delete inferior-S-debug-prompt
268
 
;;                     (kill-line)
269
 
;;                     (insert "> ")))
270
 
;;
271
 
;;           (if (< (point) start-of-output) (goto-char start-of-output))
272
 
;;           (not (looking-at inferior-S-primary-prompt)))))))
 
253
;;           ;; get output if there is some ready
 
254
;;           (accept-process-output proc 0 500)
 
255
;;           (goto-char (marker-position (process-mark proc)))
 
256
;;           (beginning-of-line)
 
257
;;
 
258
;;           (if (re-search-forward inferior-S-debug-prompt nil t)
 
259
;;               (if (equal (get-buffer S-error-buffer-name)
 
260
;;                          (get-buffer S-error-buffer-name))
 
261
;;                   (let* ((sprocess (get-S-process S-current-process-name))
 
262
;;                          (sbuffer (process-buffer sprocess)))
 
263
;;                     (set-buffer sbuffer)
 
264
;;                     (process-send-string sprocess "n\n")
 
265
;;                     (accept-process-output sprocess)
 
266
;;                     (beginning-of-line); delete inferior-S-debug-prompt
 
267
;;                     (kill-line)
 
268
;;                     (insert "> ")))
 
269
;;
 
270
;;           (if (< (point) start-of-output) (goto-char start-of-output))
 
271
;;           (not (looking-at inferior-S-primary-prompt)))))))
273
272
;;
274
273
 
275
274