emu.el

   1 ;;; emu.el --- Emulation module for each Emacs variants
   2
   3 ;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; Version: $Id: emu.el,v 7.46 1997/08/30 08:10:50 morioka Exp $
   7 ;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs
   8
   9 ;; This file is part of emu.
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Code:
  27
  28 (defmacro defun-maybe (name &rest everything-else)
  29   (or (and (fboundp name)
  30            (not (get name 'defun-maybe))
  31            )
  32       (` (or (fboundp (quote (, name)))
  33              (progn
  34                (defun (, name) (,@ everything-else))
  35                (put (quote (, name)) 'defun-maybe t)
  36                ))
  37          )))
  38
  39 (defmacro defmacro-maybe (name &rest everything-else)
  40   (or (and (fboundp name)
  41            (not (get name 'defmacro-maybe))
  42            )
  43       (` (or (fboundp (quote (, name)))
  44              (progn
  45                (defmacro (, name) (,@ everything-else))
  46                (put (quote (, name)) 'defmacro-maybe t)
  47                ))
  48          )))
  49
  50 (put 'defun-maybe 'lisp-indent-function 'defun)
  51 (put 'defmacro-maybe 'lisp-indent-function 'defun)
  52
  53 (defmacro defconst-maybe (name &rest everything-else)
  54   (or (and (boundp name)
  55            (not (get name 'defconst-maybe))
  56            )
  57       (` (or (boundp (quote (, name)))
  58              (progn
  59                (defconst (, name) (,@ everything-else))
  60                (put (quote (, name)) 'defconst-maybe t)
  61                ))
  62          )))
  63
  64
  65 (defconst-maybe emacs-major-version (string-to-int emacs-version))
  66 (defconst-maybe emacs-minor-version
  67   (string-to-int
  68    (substring emacs-version
  69               (string-match (format "%d\\." emacs-major-version)
  70                             emacs-version))))
  71
  72 (defvar running-emacs-18 (<= emacs-major-version 18))
  73 (defvar running-xemacs (string-match "XEmacs" emacs-version))
  74
  75 (defvar running-mule-merged-emacs (and (not (boundp 'MULE))
  76                                        (not running-xemacs) (featurep 'mule)))
  77 (defvar running-xemacs-with-mule (and running-xemacs (featurep 'mule)))
  78
  79 (defvar running-emacs-19 (and (not running-xemacs) (= emacs-major-version 19)))
  80 (defvar running-emacs-19_29-or-later
  81   (or (and running-emacs-19 (>= emacs-minor-version 29))
  82       (and (not running-xemacs)(>= emacs-major-version 20))))
  83
  84 (defvar running-xemacs-19 (and running-xemacs
  85                                (= emacs-major-version 19)))
  86 (defvar running-xemacs-20-or-later (and running-xemacs
  87                                         (>= emacs-major-version 20)))
  88 (defvar running-xemacs-19_14-or-later
  89   (or (and running-xemacs-19 (>= emacs-minor-version 14))
  90       running-xemacs-20-or-later))
  91
  92 (cond (running-mule-merged-emacs
  93        ;; for mule merged EMACS
  94        (require 'emu-e20)
  95        )
  96       (running-xemacs-with-mule
  97        ;; for XEmacs/mule
  98        (require 'emu-x20)
  99        )
 100       ((boundp 'MULE)
 101        ;; for MULE 1.* and 2.*
 102        (require 'emu-mule)
 103        )
 104       ((boundp 'NEMACS)
 105        ;; for NEmacs and NEpoch
 106        (require 'emu-nemacs)
 107        )
 108       (t
 109        ;; for EMACS 19 and XEmacs 19 (without mule)
 110        (require 'emu-e19)
 111        ))
 112
 113
 114 ;;; @ MIME charset
 115 ;;;
 116
 117 (defun charsets-to-mime-charset (charsets)
 118   "Return MIME charset from list of charset CHARSETS.
 119 This function refers variable `charsets-mime-charset-alist'
 120 and `default-mime-charset'."
 121   (if charsets
 122       (or (catch 'tag
 123             (let ((rest charsets-mime-charset-alist)
 124                   cell)
 125               (while (setq cell (car rest))
 126                 (if (catch 'not-subset
 127                       (let ((set1 charsets)
 128                             (set2 (car cell))
 129                             obj)
 130                         (while set1
 131                           (setq obj (car set1))
 132                           (or (memq obj set2)
 133                               (throw 'not-subset nil)
 134                               )
 135                           (setq set1 (cdr set1))
 136                           )
 137                         t))
 138                     (throw 'tag (cdr cell))
 139                   )
 140                 (setq rest (cdr rest))
 141                 )))
 142           default-mime-charset)))
 143
 144
 145 ;;; @ Emacs 19 emulation
 146 ;;;
 147
 148 (defun-maybe minibuffer-prompt-width ()
 149   "Return the display width of the minibuffer prompt."
 150   (save-excursion
 151     (set-buffer (window-buffer (minibuffer-window)))
 152     (current-column)
 153     ))
 154
 155
 156 ;;; @ Emacs 19.29 emulation
 157 ;;;
 158
 159 (defvar path-separator ":"
 160   "Character used to separate concatenated paths.")
 161
 162 (defun-maybe buffer-substring-no-properties (start end)
 163   "Return the characters of part of the buffer, without the text properties.
 164 The two arguments START and END are character positions;
 165 they can be in either order. [Emacs 19.29 emulating function]"
 166   (let ((string (buffer-substring start end)))
 167     (set-text-properties 0 (length string) nil string)
 168     string))
 169
 170 (defun-maybe match-string (num &optional string)
 171   "Return string of text matched by last search.
 172 NUM specifies which parenthesized expression in the last regexp.
 173  Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
 174 Zero means the entire text matched by the whole regexp or whole string.
 175 STRING should be given if the last search was by `string-match' on STRING.
 176 \[Emacs 19.29 emulating function]"
 177   (if (match-beginning num)
 178       (if string
 179           (substring string (match-beginning num) (match-end num))
 180         (buffer-substring (match-beginning num) (match-end num)))))
 181
 182 (or running-emacs-19_29-or-later
 183     running-xemacs
 184     ;; for Emacs 19.28 or earlier
 185     (fboundp 'si:read-string)
 186     (progn
 187       (fset 'si:read-string (symbol-function 'read-string))
 188
 189       (defun read-string (prompt &optional initial-input history)
 190         "Read a string from the minibuffer, prompting with string PROMPT.
 191 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
 192 The third arg HISTORY, is dummy for compatibility. [emu.el]
 193 See `read-from-minibuffer' for details of HISTORY argument."
 194         (si:read-string prompt initial-input)
 195         )
 196       ))
 197
 198
 199 ;;; @ Emacs 19.30 emulation
 200 ;;;
 201
 202 ;; This function was imported Emacs 19.30.
 203 (defun-maybe add-to-list (list-var element)
 204   "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
 205 If you want to use `add-to-list' on a variable that is not defined
 206 until a certain package is loaded, you should put the call to `add-to-list'
 207 into a hook function that will be run only after loading the package.
 208 \[Emacs 19.30 emulating function]"
 209   (or (member element (symbol-value list-var))
 210       (set list-var (cons element (symbol-value list-var)))
 211       ))
 212
 213 (cond ((fboundp 'insert-file-contents-literally)
 214        )
 215       ((boundp 'file-name-handler-alist)
 216        (defun insert-file-contents-literally
 217          (filename &optional visit beg end replace)
 218          "Like `insert-file-contents', q.v., but only reads in the file.
 219 A buffer may be modified in several ways after reading into the buffer due
 220 to advanced Emacs features, such as file-name-handlers, format decoding,
 221 find-file-hooks, etc.
 222   This function ensures that none of these modifications will take place.
 223 \[Emacs 19.30 emulating function]"
 224          (let (file-name-handler-alist)
 225            (insert-file-contents filename visit beg end replace)
 226            ))
 227        )
 228       (t
 229        (defalias 'insert-file-contents-literally 'insert-file-contents)
 230        ))
 231
 232
 233 ;;; @ Emacs 19.31 emulation
 234 ;;;
 235
 236 (defun-maybe buffer-live-p (object)
 237   "Return non-nil if OBJECT is a buffer which has not been killed.
 238 Value is nil if OBJECT is not a buffer or if it has been killed.
 239 \[Emacs 19.31 emulating function]"
 240   (and object
 241        (get-buffer object)
 242        (buffer-name (get-buffer object))
 243        ))
 244
 245 ;; This macro was imported Emacs 19.33.
 246 (defmacro-maybe save-selected-window (&rest body)
 247   "Execute BODY, then select the window that was selected before BODY.
 248 \[Emacs 19.31 emulating function]"
 249   (list 'let
 250         '((save-selected-window-window (selected-window)))
 251         (list 'unwind-protect
 252               (cons 'progn body)
 253               (list 'select-window 'save-selected-window-window))))
 254
 255
 256 ;;; @ XEmacs emulation
 257 ;;;
 258
 259 (defun-maybe functionp (obj)
 260   "Returns t if OBJ is a function, nil otherwise.
 261 \[XEmacs emulating function]"
 262   (or (subrp obj)
 263       (byte-code-function-p obj)
 264       (and (symbolp obj)(fboundp obj))
 265       (and (consp obj)(eq (car obj) 'lambda))
 266       ))
 267
 268 (defun-maybe point-at-eol (&optional arg buffer)
 269   "Return the character position of the last character on the current line.
 270 With argument N not nil or 1, move forward N - 1 lines first.
 271 If scan reaches end of buffer, return that position.
 272 This function does not move point. [XEmacs emulating function]"
 273   (save-excursion
 274     (if buffer
 275         (set-buffer buffer)
 276       )
 277     (if arg
 278         (forward-line (1- arg))
 279       )
 280     (end-of-line)
 281     (point)
 282     ))
 283
 284
 285 ;;; @ for XEmacs 20
 286 ;;;
 287
 288 (or (fboundp 'char-int)
 289     (fset 'char-int (symbol-function 'identity))
 290     )
 291 (or (fboundp 'int-char)
 292     (fset 'int-char (symbol-function 'identity))
 293     )
 294 (or (fboundp 'char-or-char-int-p)
 295     (fset 'char-or-char-int-p (symbol-function 'integerp))
 296     )
 297
 298
 299 ;;; @ for text/richtext and text/enriched
 300 ;;;
 301
 302 (cond ((fboundp 'richtext-decode)
 303        ;; have richtext.el
 304        )
 305       ((or running-emacs-19_29-or-later running-xemacs-19_14-or-later)
 306        ;; have enriched.el
 307        (autoload 'richtext-decode "richtext")
 308        (or (assq 'text/richtext format-alist)
 309            (setq format-alist
 310                  (cons
 311                   (cons 'text/richtext
 312                         '("Extended MIME text/richtext format."
 313                           "Content-[Tt]ype:[ \t]*text/richtext"
 314                           richtext-decode richtext-encode t enriched-mode))
 315                   format-alist)))
 316        )
 317       (t
 318        ;; don't have enriched.el
 319        (autoload 'richtext-decode "tinyrich")
 320        (autoload 'enriched-decode "tinyrich")
 321        ))
 322
 323
 324 ;;; @ end
 325 ;;;
 326
 327 (provide 'emu)
 328
 329 ;;; emu.el ends here