/usr/share/emacs/site-lisp/ess/ess-compat.el is in ess 12.04-4-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 | ;;; ess-compat.el --- simple determination of Emacs/XEmacs and version #.
;; Copyright (C) 2000--2005 A.J. Rossini, Rich M. Heiberger, Martin
;; Maechler, Kurt Hornik, Rodney Sparapani, and Stephen Eglen.
;; Author: A.J. Rossini <rossini@biostat.washington.edu>
;; Created: 07 June 2000
;; Maintainer: ESS-core <ESS-core@r-project.org>
;; Keywords: languages
;; This file is part of ESS
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING. If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
;;; Commentary:
;; This file contains functions for easily determining features of the
;; version of Emacs that we are using. In particular, it look for
;; version number, customize support, as well as Emacs/XEmacs, for
;; flaggin support later on.
;;; Code:
;;; Define a function to make it easier to check which version we're
;;; running.
(defun ess-running-emacs-version-or-newer (major minor)
(or (> emacs-major-version major)
(and (= emacs-major-version major)
(>= emacs-minor-version minor))))
;(defvar ess-running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
(defvar ess-local-custom-available (featurep 'custom)
"Value is nil if custom.el not available, t if available.
Only a concern with earlier versions of Emacs.")
;; FIXME: When emacs is started from Cygwin shell in Windows,
;; we have (equal window-system 'x) -and should use "--ess" in *d-r.el
(defvar ess-microsoft-p (or (equal window-system 'w32)
;; XEmacs only...
;;; (equal (console-type) 'pc)
;;; (equal (console-type) 'mswindows)
(equal window-system 'win32)
(equal window-system 'mswindows))
"Value is t if the OS is one of Microsoft's, nil otherwise.")
;; These definitions are for Emacs versions < 20.4 or XEmacs
;; These are taken verbatim from the file emacs-20.6/lisp/w32-fns.el
;;
;; Note: 20.3 and 19.x NTemacs users are strongly encouraged to upgrade to
;; version 20.4 or higher. NTemacs 20.2 is not supported by ESS.
;; XEmacs 20.x needs this
(if (not (fboundp 'find-buffer-visiting))
(fset 'find-buffer-visiting 'get-file-buffer))
;; XEmacs <= 21.4.15 needs this:
(defalias 'ess-line-beginning-position
(if (fboundp 'line-beginning-position)
'line-beginning-position
'point-at-bol))
(if (and (not (featurep 'xemacs))
(string-match "XEmacs\\|Lucid" emacs-version))
(provide 'xemacs))
;; XEmacs 21.x and Emacs 20.x need this
(cond ((fboundp 'replace-regexp-in-string)
(defalias 'ess-replace-regexp-in-string 'replace-regexp-in-string))
((featurep 'xemacs)
(defun ess-replace-regexp-in-string(regexp replace string)
"Mimic GNU Emacs function replace-regexp-in-string with XEmacs' replace-in-string"
(replace-in-string string regexp replace)))
;; GNU emacs <= 20 -- take Emacs' 21(.3)'s definition:
(t (defun ess-replace-regexp-in-string (regexp rep string &optional
fixedcase literal subexp start)
"Replace all matches for REGEXP with REP in STRING.
Return a new string containing the replacements.
Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
arguments with the same names of function `replace-match'. If START
is non-nil, start replacements at that index in STRING.
REP is either a string used as the NEWTEXT arg of `replace-match' or a
function. If it is a function it is applied to each match to generate
the replacement passed to `replace-match'; the match-data at this
point are such that match 0 is the function's argument.
To replace only the first match (if any), make REGEXP match up to \\'
and replace a sub-expression, e.g.
(ess-replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
=> \" bar foo\"
"
;; To avoid excessive consing from multiple matches in long strings,
;; don't just call `replace-match' continually. Walk down the
;; string looking for matches of REGEXP and building up a (reversed)
;; list MATCHES. This comprises segments of STRING which weren't
;; matched interspersed with replacements for segments that were.
;; [For a `large' number of replacments it's more efficient to
;; operate in a temporary buffer; we can't tell from the function's
;; args whether to choose the buffer-based implementation, though it
;; might be reasonable to do so for long enough STRING.]
(let ((l (length string))
(start (or start 0))
matches str mb me)
(save-match-data
(while (and (< start l) (string-match regexp string start))
(setq mb (match-beginning 0)
me (match-end 0))
;; If we matched the empty string, make sure we advance by one char
(when (= me mb) (setq me (min l (1+ mb))))
;; Generate a replacement for the matched substring.
;; Operate only on the substring to minimize string consing.
;; Set up match data for the substring for replacement;
;; presumably this is likely to be faster than munging the
;; match data directly in Lisp.
(string-match regexp (setq str (substring string mb me)))
(setq matches
(cons (replace-match (if (stringp rep)
rep
(funcall rep (match-string 0 str)))
fixedcase literal str subexp)
(cons (substring string start mb) ; unmatched prefix
matches)))
(setq start me))
;; Reconstruct a string from the pieces.
(setq matches (cons (substring string start l) matches)) ; leftover
(apply #'concat (nreverse matches)))))
)
)
;; remassoc exists as a built-in function in xemacs, but
;; not in GNU emacs
;;
(if (not (functionp 'remassoc))
(defun remassoc (key a)
"remove an association pair from an alist"
(if a
(let ((pair (car a)))
(if (equal (car pair) key)
(cdr a)
(cons pair (remassoc key (cdr a))))))))
(if (not (fboundp 'w32-using-nt))
(defun w32-using-nt ()
"Return non-nil if literally running on Windows NT (i.e., not Windows 9X)."
(and (eq system-type 'windows-nt) (getenv "SystemRoot"))))
(if (and (featurep 'xemacs)
(fboundp 'extent-at)
(fboundp 'make-extent)
(fboundp 'set-extent-property))
(defun ess-xemacs-insert-glyph (gl)
"Insert a glyph at the left edge of point."
(let ((prop 'myimage) ;; myimage is an arbitrary name, chosen to
;; (hopefully) not conflict with any other
;; properties. Change it if necessary.
extent)
;; First, check to see if one of our extents already exists at
;; point. For ease-of-programming, we are creating and using our
;; own extents (multiple extents are allowed to exist/overlap at the
;; same point, and it's quite possible for other applications to
;; embed extents in the current buffer without your knowledge).
;; Basically, if an extent, with the property stored in "prop",
;; exists at point, we assume that it is one of ours, and we re-use
;; it (this is why it is important for the property stored in "prop"
;; to be unique, and only used by us).
(if (not (setq extent (extent-at (point) (current-buffer) prop)))
(progn
;; If an extent does not already exist, create a zero-length
;; extent, and give it our special property.
(setq extent (make-extent (point) (point) (current-buffer)))
(set-extent-property extent prop t)
))
;; Display the glyph by storing it as the extent's "begin-glyph".
(set-extent-property extent 'begin-glyph gl))))
;; XEmacs and NTemacs 19.x need these
(if (not (boundp 'w32-system-shells))
(defvar w32-system-shells '("cmd" "cmd.exe" "command" "command.com"
"4nt" "4nt.exe" "4dos" "4dos.exe"
"ndos" "ndos.exe")
"List of strings recognized as Windows NT/9X system shells.")
)
(if (not (fboundp 'w32-system-shell-p))
(defun w32-system-shell-p (shell-name)
(and shell-name
(member (downcase (file-name-nondirectory shell-name))
w32-system-shells)))
)
(if (not (fboundp 'w32-shell-name))
(defun w32-shell-name ()
"Return the name of the shell being used."
(or (and (boundp 'explicit-shell-file-name) explicit-shell-file-name)
(getenv "ESHELL")
(getenv "SHELL")
(and (w32-using-nt) "cmd.exe")
"command.com"))
)
;; XEmacs and NTemacs 20.3 need this
(if (not (fboundp 'w32-shell-dos-semantics)) (defun w32-shell-dos-semantics ()
"Return t if the interactive shell being used expects msdos shell semantics."
(or (w32-system-shell-p (w32-shell-name))
(and (member (downcase (file-name-nondirectory (w32-shell-name)))
'("cmdproxy" "cmdproxy.exe"))
(w32-system-shell-p (getenv "COMSPEC")))))
)
;; XEmacs need this (unless configured with --with-mule=yes)
(if (not (boundp 'enable-multibyte-characters))
(defvar enable-multibyte-characters nil
"Non-nil means the buffer contents are regarded as multi-byte characters.
This concept is handled completely differently on Xemacs."))
(defvar ess-has-tooltip
(and (not (featurep 'xemacs))
(>= emacs-major-version 21))
"non-nil if 'tooltip can be required; typically nil for Xemacs.")
;; XEmacs on Windows needs this
(if (and ess-microsoft-p
(not (fboundp 'w32-short-file-name)))
(cond ((fboundp 'win32-short-file-name)
(fset 'w32-short-file-name 'win32-short-file-name))
((fboundp 'mswindows-short-file-name)
(fset 'w32-short-file-name 'mswindows-short-file-name))
(t
(warn "None of 'w32-short-file-name, 'win32-short-file-name,
or 'mswindows-short-file-name are defined!
You will have to manually set ess-program-files (in ess-custom.el) to
the correct \"8.3\"-style directory name."))))
(defun ess-sleep ()
"Put emacs to sleep for `ess-sleep-for-shell' seconds (floats work).
Sometimes its necessary to wait for a shell prompt."
(if (featurep 'xemacs) (sleep-for ess-sleep-for-shell)
(sleep-for 0 (truncate (* ess-sleep-for-shell 1000)))))
(provide 'ess-compat)
; Local variables section
;;; This file is automatically placed in Outline minor mode.
;;; The file is structured as follows:
;;; Chapters: ^L ;
;;; Sections: ;;*;;
;;; Subsections: ;;;*;;;
;;; Components: defuns, defvars, defconsts
;;; Random code beginning with a ;;;;* comment
;;; Local variables:
;;; mode: emacs-lisp
;;; mode: outline-minor
;;; outline-regexp: "\^L\\|\\`;\\|;;\\*\\|;;;\\*\\|(def[cvu]\\|(setq\\|;;;;\\*"
;;; End:
;;; ess-compat.el ends here
|