X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=emu.el;h=066dc18da2eb613e73d58a5f516387cca19f7030;hb=refs%2Fheads%2Ftomo;hp=8d5cebdc64f7d3cb4c151f73c7967a08acfd609e;hpb=71851275e841060de5eefb7ac5de23b0dca47e02;p=elisp%2Fapel.git diff --git a/emu.el b/emu.el index 8d5cebd..066dc18 100644 --- a/emu.el +++ b/emu.el @@ -1,67 +1,124 @@ -;;; ;;; emu.el --- Emulation module for each Emacs variants -;;; -;;; Copyright (C) 1995 Free Software Foundation, Inc. -;;; Copyright (C) 1995,1996 MORIOKA Tomohiko -;;; -;;; Author: MORIOKA Tomohiko -;;; modified by KOBAYASHI Shuhei -;;; Version: -;;; $Id: emu.el,v 7.19 1996/07/11 14:11:12 morioka Exp $ -;;; Keywords: emulation, compatibility, NEmacs, Mule, XEmacs -;;; -;;; This file is part of tl (Tiny Library). -;;; -;;; This program 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 program 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 This program. If not, write to the Free Software -;;; Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. -;;; + +;; Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Version: $Id: emu.el,v 7.48 1997/09/07 02:37:40 morioka Exp $ +;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs + +;; This file is part of emu. + +;; This program 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 program 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, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + ;;; Code: -(or (boundp 'emacs-major-version) - (defconst emacs-major-version (string-to-int emacs-version))) -(or (boundp 'emacs-minor-version) - (defconst emacs-minor-version - (string-to-int - (substring emacs-version (string-match "18\\." emacs-version))))) +(defmacro defun-maybe (name &rest everything-else) + (or (and (fboundp name) + (not (get name 'defun-maybe)) + ) + (` (or (fboundp (quote (, name))) + (progn + (defun (, name) (,@ everything-else)) + (put (quote (, name)) 'defun-maybe t) + )) + ))) + +(defmacro defsubst-maybe (name &rest everything-else) + (or (and (fboundp name) + (not (get name 'defsubst-maybe)) + ) + (` (or (fboundp (quote (, name))) + (progn + (defsubst (, name) (,@ everything-else)) + (put (quote (, name)) 'defsubst-maybe t) + )) + ))) + +(defmacro defmacro-maybe (name &rest everything-else) + (or (and (fboundp name) + (not (get name 'defmacro-maybe)) + ) + (` (or (fboundp (quote (, name))) + (progn + (defmacro (, name) (,@ everything-else)) + (put (quote (, name)) 'defmacro-maybe t) + )) + ))) + +(put 'defun-maybe 'lisp-indent-function 'defun) +(put 'defsubst-maybe 'lisp-indent-function 'defun) +(put 'defmacro-maybe 'lisp-indent-function 'defun) + +(defmacro defconst-maybe (name &rest everything-else) + (or (and (boundp name) + (not (get name 'defconst-maybe)) + ) + (` (or (boundp (quote (, name))) + (progn + (defconst (, name) (,@ everything-else)) + (put (quote (, name)) 'defconst-maybe t) + )) + ))) + + +(defconst-maybe emacs-major-version (string-to-int emacs-version)) +(defconst-maybe emacs-minor-version + (string-to-int + (substring emacs-version + (string-match (format "%d\\." emacs-major-version) + emacs-version)))) (defvar running-emacs-18 (<= emacs-major-version 18)) (defvar running-xemacs (string-match "XEmacs" emacs-version)) + +(defvar running-mule-merged-emacs (and (not (boundp 'MULE)) + (not running-xemacs) (featurep 'mule))) +(defvar running-xemacs-with-mule (and running-xemacs (featurep 'mule))) + +(defvar running-emacs-19 (and (not running-xemacs) (= emacs-major-version 19))) +(defvar running-emacs-19_29-or-later + (or (and running-emacs-19 (>= emacs-minor-version 29)) + (and (not running-xemacs)(>= emacs-major-version 20)))) + (defvar running-xemacs-19 (and running-xemacs (= emacs-major-version 19))) -(defvar running-xemacs-20 (and running-xemacs - (= emacs-major-version 20))) (defvar running-xemacs-20-or-later (and running-xemacs (>= emacs-major-version 20))) (defvar running-xemacs-19_14-or-later (or (and running-xemacs-19 (>= emacs-minor-version 14)) running-xemacs-20-or-later)) -(defvar running-emacs-19 (and (not running-xemacs) - (= emacs-major-version 19))) -(defvar running-emacs-19_29-or-later - (or (and running-emacs-19 (>= emacs-minor-version 29)) - (and (not running-xemacs)(>= emacs-major-version 20)))) -(cond ((boundp 'MULE) - (require 'emu-mule) +(cond (running-mule-merged-emacs + ;; for mule merged EMACS + (require 'emu-e20) ) - ((and running-xemacs-20 (featurep 'mule)) + (running-xemacs-with-mule + ;; for XEmacs/mule (require 'emu-x20) ) + ((boundp 'MULE) + ;; for MULE 1.* and 2.* + (require 'emu-mule) + ) ((boundp 'NEMACS) + ;; for NEmacs and NEpoch (require 'emu-nemacs) ) (t + ;; for EMACS 19 and XEmacs 19 (without mule) (require 'emu-e19) )) @@ -72,11 +129,11 @@ (defun charsets-to-mime-charset (charsets) "Return MIME charset from list of charset CHARSETS. This function refers variable `charsets-mime-charset-alist' -and `default-mime-charset'. [emu.el]" +and `default-mime-charset'." (if charsets (or (catch 'tag (let ((rest charsets-mime-charset-alist) - cell csl) + cell) (while (setq cell (car rest)) (if (catch 'not-subset (let ((set1 charsets) @@ -97,55 +154,145 @@ and `default-mime-charset'. [emu.el]" default-mime-charset))) +;;; @ Emacs 19 emulation +;;; + +(defun-maybe minibuffer-prompt-width () + "Return the display width of the minibuffer prompt." + (save-excursion + (set-buffer (window-buffer (minibuffer-window))) + (current-column) + )) + + ;;; @ Emacs 19.29 emulation ;;; -(or (fboundp 'buffer-substring-no-properties) - (defun buffer-substring-no-properties (beg end) - "Return the text from BEG to END, without text properties, as a string." - (let ((string (buffer-substring beg end))) - (tl:set-text-properties 0 (length string) nil string) - string)) - ) +(defvar path-separator ":" + "Character used to separate concatenated paths.") + +(defun-maybe buffer-substring-no-properties (start end) + "Return the characters of part of the buffer, without the text properties. +The two arguments START and END are character positions; +they can be in either order. [Emacs 19.29 emulating function]" + (let ((string (buffer-substring start end))) + (set-text-properties 0 (length string) nil string) + string)) + +(defun-maybe match-string (num &optional string) + "Return string of text matched by last search. +NUM specifies which parenthesized expression in the last regexp. + Value is nil if NUMth pair didn't match, or there were less than NUM pairs. +Zero means the entire text matched by the whole regexp or whole string. +STRING should be given if the last search was by `string-match' on STRING. +\[Emacs 19.29 emulating function]" + (if (match-beginning num) + (if string + (substring string (match-beginning num) (match-end num)) + (buffer-substring (match-beginning num) (match-end num))))) + +(or running-emacs-19_29-or-later + running-xemacs + ;; for Emacs 19.28 or earlier + (fboundp 'si:read-string) + (progn + (fset 'si:read-string (symbol-function 'read-string)) + + (defun read-string (prompt &optional initial-input history) + "Read a string from the minibuffer, prompting with string PROMPT. +If non-nil, second arg INITIAL-INPUT is a string to insert before reading. +The third arg HISTORY, is dummy for compatibility. [emu.el] +See `read-from-minibuffer' for details of HISTORY argument." + (si:read-string prompt initial-input) + ) + )) -(cond ((or running-emacs-19_29-or-later running-xemacs) - ;; for Emacs 19.29 or later and XEmacs - (defalias 'tl:read-string 'read-string) - ) - (t - ;; for Emacs 19.28 or earlier - (defun tl:read-string (prompt &optional initial-input history) - (read-string prompt initial-input) - ) - )) -(or (fboundp 'add-to-list) - ;; This function was imported Emacs 19.30. - (defun add-to-list (list-var element) - "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. +;;; @ Emacs 19.30 emulation +;;; + +;; This function was imported Emacs 19.30. +(defun-maybe add-to-list (list-var element) + "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. If you want to use `add-to-list' on a variable that is not defined until a certain package is loaded, you should put the call to `add-to-list' into a hook function that will be run only after loading the package. -\[emu.el; Emacs 19.30 emulating function]" - (or (member element (symbol-value list-var)) - (set list-var (cons element (symbol-value list-var))))) - ) +\[Emacs 19.30 emulating function]" + (or (member element (symbol-value list-var)) + (set list-var (cons element (symbol-value list-var))) + )) + +(cond ((fboundp 'insert-file-contents-literally) + ) + ((boundp 'file-name-handler-alist) + (defun insert-file-contents-literally + (filename &optional visit beg end replace) + "Like `insert-file-contents', q.v., but only reads in the file. +A buffer may be modified in several ways after reading into the buffer due +to advanced Emacs features, such as file-name-handlers, format decoding, +find-file-hooks, etc. + This function ensures that none of these modifications will take place. +\[Emacs 19.30 emulating function]" + (let (file-name-handler-alist) + (insert-file-contents filename visit beg end replace) + )) + ) + (t + (defalias 'insert-file-contents-literally 'insert-file-contents) + )) + + +;;; @ Emacs 19.31 emulation +;;; + +(defun-maybe buffer-live-p (object) + "Return non-nil if OBJECT is a buffer which has not been killed. +Value is nil if OBJECT is not a buffer or if it has been killed. +\[Emacs 19.31 emulating function]" + (and object + (get-buffer object) + (buffer-name (get-buffer object)) + )) + +;; This macro was imported Emacs 19.33. +(defmacro-maybe save-selected-window (&rest body) + "Execute BODY, then select the window that was selected before BODY. +\[Emacs 19.31 emulating function]" + (list 'let + '((save-selected-window-window (selected-window))) + (list 'unwind-protect + (cons 'progn body) + (list 'select-window 'save-selected-window-window)))) ;;; @ XEmacs emulation ;;; -(or (fboundp 'functionp) - (defun functionp (obj) - "Returns t if OBJ is a function, nil otherwise. -\[emu.el; XEmacs emulating function]" - (or (subrp obj) - (byte-code-function-p obj) - (and (symbolp obj)(fboundp obj)) - (and (consp obj)(eq (car obj) 'lambda)) - )) - ) - +(defun-maybe functionp (obj) + "Returns t if OBJ is a function, nil otherwise. +\[XEmacs emulating function]" + (or (subrp obj) + (byte-code-function-p obj) + (and (symbolp obj)(fboundp obj)) + (and (consp obj)(eq (car obj) 'lambda)) + )) + +(defun-maybe point-at-eol (&optional arg buffer) + "Return the character position of the last character on the current line. +With argument N not nil or 1, move forward N - 1 lines first. +If scan reaches end of buffer, return that position. +This function does not move point. [XEmacs emulating function]" + (save-excursion + (if buffer + (set-buffer buffer) + ) + (if arg + (forward-line (1- arg)) + ) + (end-of-line) + (point) + )) + ;;; @ for XEmacs 20 ;;; @@ -156,12 +303,18 @@ into a hook function that will be run only after loading the package. (or (fboundp 'int-char) (fset 'int-char (symbol-function 'identity)) ) +(or (fboundp 'char-or-char-int-p) + (fset 'char-or-char-int-p (symbol-function 'integerp)) + ) ;;; @ for text/richtext and text/enriched ;;; -(cond ((or running-emacs-19_29-or-later running-xemacs-19_14-or-later) +(cond ((fboundp 'richtext-decode) + ;; have richtext.el + ) + ((or running-emacs-19_29-or-later running-xemacs-19_14-or-later) ;; have enriched.el (autoload 'richtext-decode "richtext") (or (assq 'text/richtext format-alist)