X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=emu.el;h=929655d62224466385d9aee3591afa0315f0ff04;hb=b4ec5813262975ef410d9abbc886e851c5742b3f;hp=4b59ff33f3f13da3260843d4304c72475c4ce770;hpb=7f8d6d844ba8a442d54d8e6244011fa906e9df5f;p=elisp%2Fapel.git diff --git a/emu.el b/emu.el index 4b59ff3..929655d 100644 --- a/emu.el +++ b/emu.el @@ -1,45 +1,56 @@ -;;; ;;; 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.26 1996/09/05 16:31:02 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; 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 (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-19 (and running-xemacs + (= emacs-major-version 19))) (defvar running-xemacs-20 (and running-xemacs - (>= emacs-major-version 20))) + (= 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)) - (>= emacs-major-version 20))) + (and (not running-xemacs)(>= emacs-major-version 20)))) (cond ((boundp 'MULE) (require 'emu-mule) @@ -55,27 +66,103 @@ )) -;;; @ Emacs 19.29 emulation +;;; @ 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))) + + +;;; @ 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." + "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)) ) -(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 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) + ) + )) + +(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. +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.31 emulation +;;; + +(or (fboundp 'buffer-live-p) + (defun 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 @@ -104,6 +191,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 ;;;