Initial Commit

[packages] / xemacs-packages / ess / lisp / ess-emcs.el

;;; ess-emcs.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.

;; Original Author: A.J. Rossini <rossini@biostat.washington.edu>
;; Created: 07 June 2000
;; Maintainers: ESS-core <ESS-core@stat.math.ethz.ch>

;; Keywords: start up, configuration.

;; 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:

;; Older versions of emacs did not have these variables
;; (emacs-major-version and emacs-minor-version.)
;; Let's define them if they're not around, since they make
;; it much easier to conditionalize on the emacs version.

(if (and (not (boundp 'emacs-major-version))
         (string-match "^[0-9]+" emacs-version))
    (setq emacs-major-version
          (string-to-int (substring emacs-version
                                    (match-beginning 0) (match-end 0)))))
(if (and (not (boundp 'emacs-minor-version))
         (string-match "^[0-9]+\\.\\([0-9]+\\)" emacs-version))
    (setq emacs-minor-version
          (string-to-int (substring emacs-version
                                    (match-beginning 1) (match-end 1)))))

;;; 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
(if (not (fboundp 'line-beginning-position))
    (defalias '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."))


;; XEmacs on Windows needs this
(if (and ess-microsoft-p
         (not (fboundp 'w32-short-file-name)))
    (fset 'w32-short-file-name 'win32-short-file-name))

(provide 'ess-emcs)

\f ; 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-emcs.el ends here