ess-compat.el

;;; 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 <[email protected]>
;; Created: 07 June 2000
;; Maintainer: ESS-core <[email protected]>

;; 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 (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)))))

(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