299 lines
13 KiB
EmacsLisp
299 lines
13 KiB
EmacsLisp
|
;;; ess-compat.el --- simple determination of Emacs/XEmacs and version #.
|
|||
|
|
|||
|
;; Copyright (C) 2000--2005 A.J. Rossini, Richard 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.
|
|||
|
|
|||
|
;; A copy of the GNU General Public License is available at
|
|||
|
;; http://www.r-project.org/Licenses/
|
|||
|
|
|||
|
|
|||
|
;;; 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.
|
|||
|
;; no longer in use; 2013-12-30:
|
|||
|
(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 (eq system-type 'ms-dos)
|
|||
|
(eq system-type 'windows-nt))
|
|||
|
"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)))))
|
|||
|
|
|||
|
(unless (fboundp 'use-region-p)
|
|||
|
;; emacs 23 needs this
|
|||
|
(defun use-region-p ()
|
|||
|
"Return t if the region is active and it is appropriate to act on it.
|
|||
|
This is used by commands that act specially on the region under
|
|||
|
Transient Mark mode.
|
|||
|
|
|||
|
The return value is t if Transient Mark mode is enabled and the
|
|||
|
mark is active; furthermore, if `use-empty-active-region' is nil,
|
|||
|
the region must not be empty. Otherwise, the return value is nil.
|
|||
|
|
|||
|
For some commands, it may be appropriate to ignore the value of
|
|||
|
`use-empty-active-region'; in that case, use `region-active-p'."
|
|||
|
(and (region-active-p)
|
|||
|
(or use-empty-active-region (> (region-end) (region-beginning)))))
|
|||
|
|
|||
|
(defun region-active-p ()
|
|||
|
"Return t if Transient Mark mode is enabled and the mark is active.
|
|||
|
|
|||
|
Some commands act specially on the region when Transient Mark
|
|||
|
mode is enabled. Usually, such commands should use
|
|||
|
`use-region-p' instead of this function, because `use-region-p'
|
|||
|
also checks the value of `use-empty-active-region'."
|
|||
|
(and transient-mark-mode mark-active)))
|
|||
|
|
|||
|
(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
|