X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=emu.el;h=89b1e8b55c62501f12c0926834812b1d88973525;hb=refs%2Ftags%2Ftm-7_100_3;hp=4b59ff33f3f13da3260843d4304c72475c4ce770;hpb=7f8d6d844ba8a442d54d8e6244011fa906e9df5f;p=elisp%2Fapel.git diff --git a/emu.el b/emu.el index 4b59ff3..89b1e8b 100644 --- a/emu.el +++ b/emu.el @@ -1,97 +1,256 @@ -;;; ;;; 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 Shuhei KOBAYASHI -;;; Version: -;;; $Id: emu.el,v 7.10 1996/04/27 15:25:33 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 Free Software Foundation, Inc. + +;; Author: MORIOKA Tomohiko +;; Version: $Id: emu.el,v 7.37 1996/11/29 21:22:25 shuhei-k 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: +(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) + )) + ))) + +(put 'defun-maybe 'lisp-indent-function 'defun) + + (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 (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-xemacs-20 (and running-xemacs - (>= emacs-major-version 20))) -(defvar running-emacs-19 (and (not running-xemacs) - (= emacs-major-version 19))) + +(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)) - (>= emacs-major-version 20))) + (and (not running-xemacs)(>= emacs-major-version 20)))) -(cond ((boundp 'MULE) - (require 'emu-mule) +(defvar running-xemacs-19 (and running-xemacs + (= emacs-major-version 19))) +(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)) + +(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) )) -;;; @ Emacs 19.29 emulation +;;; @ binary access ;;; -(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)) - ) +(defun insert-binary-file-contents-literally + (filename &optional visit beg end replace) + "Like `insert-file-contents-literally', q.v., but don't code conversion. +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. +\[emu.el]" + (as-binary-input-file + (insert-file-contents-literally filename visit beg end replace) + )) + + +;;; @ MIME charset +;;; + +(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]" + (if charsets + (or (catch 'tag + (let ((rest charsets-mime-charset-alist) + cell csl) + (while (setq cell (car rest)) + (if (catch 'not-subset + (let ((set1 charsets) + (set2 (car cell)) + obj) + (while set1 + (setq obj (car set1)) + (or (memq obj set2) + (throw 'not-subset nil) + ) + (setq set1 (cdr set1)) + ) + t)) + (throw 'tag (cdr cell)) + ) + (setq rest (cdr rest)) + ))) + default-mime-charset))) -(cond ((or running-emacs-19_29-or-later running-xemacs) - ;; for Emacs 19.29 or later and XEmacs - (defalias 'tl:read-string 'read-string) + +;;; @ EMACS 19.29 emulation +;;; + +(defvar path-separator ":" + "Character used to separate concatenated paths.") + +(defun-maybe buffer-substring-no-properties (beg end) + "Return the text from BEG to END, without text properties, as a string. +\[emu.el; EMACS 19.29 emulating function]" + (let ((string (buffer-substring beg end))) + (tl: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. +\[emu.el; 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) + ) + )) + +;; 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 emulation +;;; + +(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. +\[emu.el; Emacs 19.30 emulating function]" + (let (file-name-handler-alist) + (insert-file-contents filename visit beg end replace) + )) ) (t - ;; for Emacs 19.28 or earlier - (defun tl:read-string (prompt &optional initial-input history) - (read-string prompt initial-input) - ) + (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. +\[emu.el; EMACS 19.31 emulating function]" + (and object + (get-buffer object) + (buffer-name (get-buffer object)) )) +(or (fboundp 'save-selected-window) + ;; This function was imported Emacs 19.33. + (defmacro save-selected-window (&rest body) + "Execute BODY, then select the window that was selected before BODY. +\[emu.el; 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. +(defun-maybe 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)) - )) - ) - + (or (subrp obj) + (byte-code-function-p obj) + (and (symbolp obj)(fboundp obj)) + (and (consp obj)(eq (car obj) 'lambda)) + )) + ;;; @ for XEmacs 20 ;;; @@ -104,6 +263,28 @@ ) +;;; @ for text/richtext and text/enriched +;;; + +(cond ((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) + (setq format-alist + (cons + (cons 'text/richtext + '("Extended MIME text/richtext format." + "Content-[Tt]ype:[ \t]*text/richtext" + richtext-decode richtext-encode t enriched-mode)) + format-alist))) + ) + (t + ;; don't have enriched.el + (autoload 'richtext-decode "tinyrich") + (autoload 'enriched-decode "tinyrich") + )) + + ;;; @ end ;;;