1
;;; ess-compat.el --- simple determination of Emacs/XEmacs and version #.
3
;; Copyright (C) 2000--2005 A.J. Rossini, Rich M. Heiberger, Martin
4
;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
6
;; Original Author: A.J. Rossini <rossini@biostat.washington.edu>
7
;; Created: 07 June 2000
8
;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>
10
;; Keywords: start up, configuration.
12
;; This file is part of ESS
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)
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.
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.
30
;; This file contains functions for easily determining features of the
31
;; version of Emacs that we are using. In particular, it look for
32
;; version number, customize support, as well as Emacs/XEmacs, for
33
;; flaggin support later on.
37
;;; Define a function to make it easier to check which version we're
40
(defun ess-running-emacs-version-or-newer (major minor)
41
(or (> emacs-major-version major)
42
(and (= emacs-major-version major)
43
(>= emacs-minor-version minor))))
45
;(defvar ess-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
47
(defvar ess-local-custom-available (featurep 'custom)
48
"Value is nil if custom.el not available, t if available.
49
Only a concern with earlier versions of Emacs.")
51
;; FIXME: When emacs is started from Cygwin shell in Windows,
52
;; we have (equal window-system 'x) -and should use "--ess" in *d-r.el
53
(defvar ess-microsoft-p (or (equal window-system 'w32)
55
;;; (equal (console-type) 'pc)
56
;;; (equal (console-type) 'mswindows)
57
(equal window-system 'win32)
58
(equal window-system 'mswindows))
59
"Value is t if the OS is one of Microsoft's, nil otherwise.")
62
;; These definitions are for Emacs versions < 20.4 or XEmacs
63
;; These are taken verbatim from the file emacs-20.6/lisp/w32-fns.el
65
;; Note: 20.3 and 19.x NTemacs users are strongly encouraged to upgrade to
66
;; version 20.4 or higher. NTemacs 20.2 is not supported by ESS.
68
;; XEmacs 20.x needs this
69
(if (not (fboundp 'find-buffer-visiting))
70
(fset 'find-buffer-visiting 'get-file-buffer))
71
;; XEmacs <= 21.4.15 needs this:
72
(defalias 'ess-line-beginning-position
73
(if (fboundp 'line-beginning-position)
74
'line-beginning-position
77
(if (and (not (featurep 'xemacs))
78
(string-match "XEmacs\\|Lucid" emacs-version))
81
;; XEmacs 21.x and Emacs 20.x need this
82
(cond ((fboundp 'replace-regexp-in-string)
83
(defalias 'ess-replace-regexp-in-string 'replace-regexp-in-string))
85
(defun ess-replace-regexp-in-string(regexp replace string)
86
"Mimic GNU Emacs function replace-regexp-in-string with XEmacs' replace-in-string"
87
(replace-in-string string regexp replace)))
89
;; GNU emacs <= 20 -- take Emacs' 21(.3)'s definition:
90
(t (defun ess-replace-regexp-in-string (regexp rep string &optional
91
fixedcase literal subexp start)
92
"Replace all matches for REGEXP with REP in STRING.
94
Return a new string containing the replacements.
96
Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
97
arguments with the same names of function `replace-match'. If START
98
is non-nil, start replacements at that index in STRING.
100
REP is either a string used as the NEWTEXT arg of `replace-match' or a
101
function. If it is a function it is applied to each match to generate
102
the replacement passed to `replace-match'; the match-data at this
103
point are such that match 0 is the function's argument.
105
To replace only the first match (if any), make REGEXP match up to \\'
106
and replace a sub-expression, e.g.
107
(ess-replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
111
;; To avoid excessive consing from multiple matches in long strings,
112
;; don't just call `replace-match' continually. Walk down the
113
;; string looking for matches of REGEXP and building up a (reversed)
114
;; list MATCHES. This comprises segments of STRING which weren't
115
;; matched interspersed with replacements for segments that were.
116
;; [For a `large' number of replacments it's more efficient to
117
;; operate in a temporary buffer; we can't tell from the function's
118
;; args whether to choose the buffer-based implementation, though it
119
;; might be reasonable to do so for long enough STRING.]
120
(let ((l (length string))
124
(while (and (< start l) (string-match regexp string start))
125
(setq mb (match-beginning 0)
127
;; If we matched the empty string, make sure we advance by one char
128
(when (= me mb) (setq me (min l (1+ mb))))
129
;; Generate a replacement for the matched substring.
130
;; Operate only on the substring to minimize string consing.
131
;; Set up match data for the substring for replacement;
132
;; presumably this is likely to be faster than munging the
133
;; match data directly in Lisp.
134
(string-match regexp (setq str (substring string mb me)))
136
(cons (replace-match (if (stringp rep)
138
(funcall rep (match-string 0 str)))
139
fixedcase literal str subexp)
140
(cons (substring string start mb) ; unmatched prefix
143
;; Reconstruct a string from the pieces.
144
(setq matches (cons (substring string start l) matches)) ; leftover
145
(apply #'concat (nreverse matches)))))
149
;; remassoc exists as a built-in function in xemacs, but
152
(if (not (functionp 'remassoc))
153
(defun remassoc (key a)
154
"remove an association pair from an alist"
156
(let ((pair (car a)))
157
(if (equal (car pair) key)
159
(cons pair (remassoc key (cdr a))))))))
161
(if (not (fboundp 'w32-using-nt))
162
(defun w32-using-nt ()
163
"Return non-nil if literally running on Windows NT (i.e., not Windows 9X)."
164
(and (eq system-type 'windows-nt) (getenv "SystemRoot"))))
166
(if (and (featurep 'xemacs)
168
(fboundp 'make-extent)
169
(fboundp 'set-extent-property))
170
(defun ess-xemacs-insert-glyph (gl)
171
"Insert a glyph at the left edge of point."
172
(let ((prop 'myimage) ;; myimage is an arbitrary name, chosen to
173
;; (hopefully) not conflict with any other
174
;; properties. Change it if necessary.
176
;; First, check to see if one of our extents already exists at
177
;; point. For ease-of-programming, we are creating and using our
178
;; own extents (multiple extents are allowed to exist/overlap at the
179
;; same point, and it's quite possible for other applications to
180
;; embed extents in the current buffer without your knowledge).
181
;; Basically, if an extent, with the property stored in "prop",
182
;; exists at point, we assume that it is one of ours, and we re-use
183
;; it (this is why it is important for the property stored in "prop"
184
;; to be unique, and only used by us).
185
(if (not (setq extent (extent-at (point) (current-buffer) prop)))
187
;; If an extent does not already exist, create a zero-length
188
;; extent, and give it our special property.
189
(setq extent (make-extent (point) (point) (current-buffer)))
190
(set-extent-property extent prop t)
192
;; Display the glyph by storing it as the extent's "begin-glyph".
193
(set-extent-property extent 'begin-glyph gl))))
195
;; XEmacs and NTemacs 19.x need these
196
(if (not (boundp 'w32-system-shells))
197
(defvar w32-system-shells '("cmd" "cmd.exe" "command" "command.com"
198
"4nt" "4nt.exe" "4dos" "4dos.exe"
200
"List of strings recognized as Windows NT/9X system shells.")
203
(if (not (fboundp 'w32-system-shell-p))
204
(defun w32-system-shell-p (shell-name)
206
(member (downcase (file-name-nondirectory shell-name))
210
(if (not (fboundp 'w32-shell-name))
211
(defun w32-shell-name ()
212
"Return the name of the shell being used."
213
(or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name)
216
(and (w32-using-nt) "cmd.exe")
220
;; XEmacs and NTemacs 20.3 need this
221
(if (not (fboundp 'w32-shell-dos-semantics)) (defun w32-shell-dos-semantics ()
222
"Return t if the interactive shell being used expects msdos shell semantics."
223
(or (w32-system-shell-p (w32-shell-name))
224
(and (member (downcase (file-name-nondirectory (w32-shell-name)))
225
'("cmdproxy" "cmdproxy.exe"))
226
(w32-system-shell-p (getenv "COMSPEC")))))
229
;; XEmacs need this (unless configured with --with-mule=yes)
230
(if (not (boundp 'enable-multibyte-characters))
231
(defvar enable-multibyte-characters nil
232
"Non-nil means the buffer contents are regarded as multi-byte characters.
233
This concept is handled completely differently on Xemacs."))
235
(defvar ess-has-tooltip
236
(and (not (featurep 'xemacs))
237
(>= emacs-major-version 21))
238
"non-nil if 'tooltip can be required; typically nil for Xemacs.")
240
;; XEmacs on Windows needs this
241
(if (and ess-microsoft-p
242
(not (fboundp 'w32-short-file-name)))
243
(cond ((fboundp 'win32-short-file-name)
244
(fset 'w32-short-file-name 'win32-short-file-name))
245
((fboundp 'mswindows-short-file-name)
246
(fset 'w32-short-file-name 'mswindows-short-file-name))
248
(warn "None of 'w32-short-file-name, 'win32-short-file-name,
249
or 'mswindows-short-file-name are defined!
250
You will have to manually set ess-program-files (in ess-custom.el) to
251
the correct \"8.3\"-style directory name."))))
255
"Put emacs to sleep for `ess-sleep-for' seconds (floats work).
256
Sometimes its necessary to wait for a shell prompt."
257
(if (featurep 'xemacs) (sleep-for ess-sleep-for)
258
(sleep-for 0 (truncate (* ess-sleep-for 1000)))))
260
(provide 'ess-compat)
262
; Local variables section
264
;;; This file is automatically placed in Outline minor mode.
265
;;; The file is structured as follows:
268
;;; Subsections: ;;;*;;;
269
;;; Components: defuns, defvars, defconsts
270
;;; Random code beginning with a ;;;;* comment
273
;;; mode: outline-minor
274
;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
277
;;; ess-compat.el ends here
added
removed
lisp/ess-compat.el
