1
1
;;; ess-emcs.el --- simple determination of Emacs/XEmacs and version #.
3
;; Copyright (C) 2000--2001 A.J. Rossini <rossini@u.washington.edu>,
4
;; R.M. Heiberger <rmh@surfer.sbm.temple.edu>,
5
;; Martin Maechler <maechler@stat.math.ethz.ch>,
6
;; Kurt Hornik <hornik@ci.tuwien.ac.at>, and
7
;; Rodney Sparapani <rsparapa@mcw.edu>.
3
;; Copyright (C) 2000--2005 A.J. Rossini, Rich M. Heiberger, Martin
4
;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
9
;; Author: A.J. Rossini <rossini@biostat.washington.edu>
10
;; Maintainer: A.J. Rossini <rossini@biostat.washington.edu>
6
;; Original Author: A.J. Rossini <rossini@biostat.washington.edu>
11
7
;; Created: 07 June 2000
12
;; Modified: $Date: 2001/11/01 19:33:24 $
13
;; Version: $Revision: 5.14 $
14
;; RCS: $Id: ess-emcs.el,v 5.14 2001/11/01 19:33:24 ess Exp $
8
;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>
16
10
;; Keywords: start up, configuration.
18
12
;; This file is part of ESS
88
84
;; XEmacs 20.x needs this
89
85
(if (not (fboundp 'find-buffer-visiting))
90
86
(fset 'find-buffer-visiting 'get-file-buffer))
92
;; XEmacs 21.x need this
87
;; XEmacs <= 21.4.15 needs this
88
(if (not (fboundp 'line-beginning-position))
89
(defalias 'line-beginning-position 'point-at-bol))
91
(if (and (not (featurep 'xemacs))
92
(string-match "XEmacs\\|Lucid" emacs-version))
95
;; XEmacs 21.x and Emacs 20.x need this
96
(cond ((fboundp 'replace-regexp-in-string)
97
(defalias 'ess-replace-regexp-in-string 'replace-regexp-in-string))
99
(defun ess-replace-regexp-in-string(regexp replace string)
100
"Mimic GNU Emacs function replace-regexp-in-string with XEmacs' replace-in-string"
101
(replace-in-string string regexp replace)))
103
;; GNU emacs <= 20 -- take Emacs' 21(.3)'s definition:
104
(t (defun ess-replace-regexp-in-string (regexp rep string &optional
105
fixedcase literal subexp start)
106
"Replace all matches for REGEXP with REP in STRING.
108
Return a new string containing the replacements.
110
Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
111
arguments with the same names of function `replace-match'. If START
112
is non-nil, start replacements at that index in STRING.
114
REP is either a string used as the NEWTEXT arg of `replace-match' or a
115
function. If it is a function it is applied to each match to generate
116
the replacement passed to `replace-match'; the match-data at this
117
point are such that match 0 is the function's argument.
119
To replace only the first match (if any), make REGEXP match up to \\'
120
and replace a sub-expression, e.g.
121
(ess-replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
125
;; To avoid excessive consing from multiple matches in long strings,
126
;; don't just call `replace-match' continually. Walk down the
127
;; string looking for matches of REGEXP and building up a (reversed)
128
;; list MATCHES. This comprises segments of STRING which weren't
129
;; matched interspersed with replacements for segments that were.
130
;; [For a `large' number of replacments it's more efficient to
131
;; operate in a temporary buffer; we can't tell from the function's
132
;; args whether to choose the buffer-based implementation, though it
133
;; might be reasonable to do so for long enough STRING.]
134
(let ((l (length string))
138
(while (and (< start l) (string-match regexp string start))
139
(setq mb (match-beginning 0)
141
;; If we matched the empty string, make sure we advance by one char
142
(when (= me mb) (setq me (min l (1+ mb))))
143
;; Generate a replacement for the matched substring.
144
;; Operate only on the substring to minimize string consing.
145
;; Set up match data for the substring for replacement;
146
;; presumably this is likely to be faster than munging the
147
;; match data directly in Lisp.
148
(string-match regexp (setq str (substring string mb me)))
150
(cons (replace-match (if (stringp rep)
152
(funcall rep (match-string 0 str)))
153
fixedcase literal str subexp)
154
(cons (substring string start mb) ; unmatched prefix
157
;; Reconstruct a string from the pieces.
158
(setq matches (cons (substring string start l) matches)) ; leftover
159
(apply #'concat (nreverse matches)))))
163
;; remassoc exists as a built-in function in xemacs, but
166
(if (not (functionp 'remassoc))
167
(defun remassoc (key a)
168
"remove an association pair from an alist"
170
(let ((pair (car a)))
171
(if (equal (car pair) key)
173
(cons pair (remassoc key (cdr a))))))))
93
175
(if (not (fboundp 'w32-using-nt))
94
176
(defun w32-using-nt ()
95
177
"Return non-nil if literally running on Windows NT (i.e., not Windows 9X)."
96
178
(and (eq system-type 'windows-nt) (getenv "SystemRoot"))))
180
(if (and (featurep 'xemacs)
182
(fboundp 'make-extent)
183
(fboundp 'set-extent-property))
184
(defun ess-xemacs-insert-glyph (gl)
185
"Insert a glyph at the left edge of point."
186
(let ((prop 'myimage) ;; myimage is an arbitrary name, chosen to
187
;; (hopefully) not conflict with any other
188
;; properties. Change it if necessary.
190
;; First, check to see if one of our extents already exists at
191
;; point. For ease-of-programming, we are creating and using our
192
;; own extents (multiple extents are allowed to exist/overlap at the
193
;; same point, and it's quite possible for other applications to
194
;; embed extents in the current buffer without your knowledge).
195
;; Basically, if an extent, with the property stored in "prop",
196
;; exists at point, we assume that it is one of ours, and we re-use
197
;; it (this is why it is important for the property stored in "prop"
198
;; to be unique, and only used by us).
199
(if (not (setq extent (extent-at (point) (current-buffer) prop)))
201
;; If an extent does not already exist, create a zero-length
202
;; extent, and give it our special property.
203
(setq extent (make-extent (point) (point) (current-buffer)))
204
(set-extent-property extent prop t)
206
;; Display the glyph by storing it as the extent's "begin-glyph".
207
(set-extent-property extent 'begin-glyph gl))))
98
209
;; XEmacs and NTemacs 19.x need these
99
210
(if (not (boundp 'w32-system-shells))
100
211
(defvar w32-system-shells '("cmd" "cmd.exe" "command" "command.com"
added
removed
lisp/ess-emcs.el
