X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=emu.el;h=038b7fbce1d58aab6418a8aec6dfc8dd2ffe870b;hb=961193295ae71b9e98645fe19000f638fc3d2651;hp=2b07a1233f537cf9220fc51b17c211589e05bb6f;hpb=3ada2f1ef9a4f7de96287169c4c966cead561b11;p=elisp%2Fapel.git diff --git a/emu.el b/emu.el index 2b07a12..038b7fb 100644 --- a/emu.el +++ b/emu.el @@ -24,64 +24,10 @@ ;;; 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) - )) - ))) - -(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)))) +(require 'poe) (defvar running-emacs-18 (<= emacs-major-version 18)) -(defvar running-xemacs (string-match "XEmacs" emacs-version)) +(defvar running-xemacs (featurep 'xemacs)) (defvar running-mule-merged-emacs (and (not (boundp 'MULE)) (not running-xemacs) (featurep 'mule))) @@ -102,326 +48,155 @@ (cond (running-xemacs ;; for XEmacs - (require 'emu-xemacs) - (if (featurep 'mule) - ;; for XEmacs with MULE - (require 'emu-x20) - ;; for XEmacs without MULE - (require 'emu-latin1) - )) - (running-mule-merged-emacs - ;; for Emacs 20.1 and 20.2 - (require 'emu-e20) + (defvar mouse-button-1 'button1) + (defvar mouse-button-2 'button2) + (defvar mouse-button-3 'button3) ) - ((boundp 'MULE) - ;; for MULE 1.* and 2.* - (require 'emu-mule) + ((>= emacs-major-version 19) + ;; mouse + (defvar mouse-button-1 [mouse-1]) + (defvar mouse-button-2 [mouse-2]) + (defvar mouse-button-3 [down-mouse-3]) + ) + (t + ;; mouse + (defvar mouse-button-1 nil) + (defvar mouse-button-2 nil) + (defvar mouse-button-3 nil) + )) + +;; for tm-7.106 +(unless (fboundp 'tl:make-overlay) + (defalias 'tl:make-overlay 'make-overlay) + (make-obsolete 'tl:make-overlay 'make-overlay) + ) +(unless (fboundp 'tl:overlay-put) + (defalias 'tl:overlay-put 'overlay-put) + (make-obsolete 'tl:overlay-put 'overlay-put) + ) +(unless (fboundp 'tl:overlay-put) + (defalias 'tl:overlay-buffer 'overlay-buffer) + (make-obsolete 'tl:overlay-buffer 'overlay-buffer) + ) + +(require 'poem) +(require 'mcharset) +(require 'invisible) + +(defsubst char-list-to-string (char-list) + "Convert list of character CHAR-LIST to string." + (apply (function string) char-list)) + +(cond ((featurep 'mule) + (cond ((featurep 'xemacs) ; for XEmacs with MULE + ;; old Mule emulating aliases + + ;;(defalias 'char-leading-char 'char-charset) + + (defun char-category (character) + "Return string of category mnemonics for CHAR in TABLE. +CHAR can be any multilingual character +TABLE defaults to the current buffer's category table." + (mapconcat (lambda (chr) + (char-to-string (int-char chr))) + (char-category-list character) + "")) + ) + ((>= emacs-major-version 20) ; for Emacs 20 + (defalias 'insert-binary-file-contents-literally + 'insert-file-contents-literally) + + ;; old Mule emulating aliases + (defun char-category (character) + "Return string of category mnemonics for CHAR in TABLE. +CHAR can be any multilingual character +TABLE defaults to the current buffer's category table." + (category-set-mnemonics (char-category-set character))) + ) + (t ; for MULE 1.* and 2.* + (require 'emu-mule) + )) ) ((boundp 'NEMACS) ;; for NEmacs and NEpoch - (require 'emu-nemacs) + + ;; old MULE emulation + (defconst *noconv* 0) + (defconst *sjis* 1) + (defconst *junet* 2) + (defconst *ctext* 2) + (defconst *internal* 3) + (defconst *euc-japan* 3) + + (defun code-convert-string (str ic oc) + "Convert code in STRING from SOURCE code to TARGET code, +On successful converion, returns the result string, +else returns nil." + (if (not (eq ic oc)) + (convert-string-kanji-code str ic oc) + str)) + + (defun code-convert-region (beg end ic oc) + "Convert code of the text between BEGIN and END from SOURCE +to TARGET. On successful conversion returns t, +else returns nil." + (if (/= ic oc) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (convert-region-kanji-code beg end ic oc))) + )) ) (t - ;; for Emacs 19 - (require 'emu-e19) - (require 'emu-latin1) + ;; for Emacs 19 and XEmacs without MULE + + ;; old MULE emulation + (defconst *internal* nil) + (defconst *ctext* nil) + (defconst *noconv* nil) + + (defun code-convert-string (str ic oc) + "Convert code in STRING from SOURCE code to TARGET code, +On successful converion, returns the result string, +else returns nil. [emu-latin1.el; old MULE emulating function]" + str) + + (defun code-convert-region (beg end ic oc) + "Convert code of the text between BEGIN and END from SOURCE +to TARGET. On successful conversion returns t, +else returns nil. [emu-latin1.el; old MULE emulating function]" + t) )) -;;; @ 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'." - (if charsets - (or (catch 'tag - (let ((rest charsets-mime-charset-alist) - cell) - (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 emulation +;;; @ Mule emulating aliases ;;; +;;; You should not use it. -(defun-maybe minibuffer-prompt-width () - "Return the display width of the minibuffer prompt." - (save-excursion - (set-buffer (window-buffer (minibuffer-window))) - (current-column))) +(or (boundp '*noconv*) + (defconst *noconv* 'binary + "Coding-system for binary. +This constant is defined to emulate old MULE anything older than MULE 2.3. +It is obsolete, so don't use it.")) -;;; @ Emacs 19.29 emulation +;;; @ without code-conversion ;;; -(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)) - )) - - -;;; @ Emacs 19.30 emulation -;;; +(defalias 'insert-binary-file-contents 'insert-file-contents-as-binary) +(make-obsolete 'insert-binary-file-contents 'insert-file-contents-as-binary) -;; 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. -\[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. +(defun-maybe 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. -\[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)))) - - -;;; @ Emacs 20.1 emulation -;;; - -;; This macro was imported Emacs 20.2. -(defmacro-maybe when (cond &rest body) - "(when COND BODY...): if COND yields non-nil, do BODY, else return nil." - (list 'if cond (cons 'progn body))) - -(defmacro-maybe save-current-buffer (&rest body) - "Save the current buffer; execute BODY; restore the current buffer. -Executes BODY just like `progn'." - (` (let ((orig-buffer (current-buffer))) - (unwind-protect - (progn (,@ body)) - (set-buffer orig-buffer))))) - -;; This macro was imported Emacs 20.2. -(defmacro-maybe with-current-buffer (buffer &rest body) - "Execute the forms in BODY with BUFFER as the current buffer. -The value returned is the value of the last form in BODY. -See also `with-temp-buffer'." - (` (save-current-buffer - (set-buffer (, buffer)) - (,@ body)))) - -;; This macro was imported Emacs 20.2. -(defmacro-maybe with-temp-file (file &rest forms) - "Create a new buffer, evaluate FORMS there, and write the buffer to FILE. -The value of the last form in FORMS is returned, like `progn'. -See also `with-temp-buffer'." - (let ((temp-file (make-symbol "temp-file")) - (temp-buffer (make-symbol "temp-buffer"))) - (` (let (((, temp-file) (, file)) - ((, temp-buffer) - (get-buffer-create (generate-new-buffer-name " *temp file*")))) - (unwind-protect - (prog1 - (with-current-buffer (, temp-buffer) - (,@ forms)) - (with-current-buffer (, temp-buffer) - (widen) - (write-region (point-min) (point-max) (, temp-file) nil 0))) - (and (buffer-name (, temp-buffer)) - (kill-buffer (, temp-buffer)))))))) - -;; This macro was imported Emacs 20.2. -(defmacro-maybe with-temp-buffer (&rest forms) - "Create a temporary buffer, and evaluate FORMS there like `progn'. -See also `with-temp-file' and `with-output-to-string'." - (let ((temp-buffer (make-symbol "temp-buffer"))) - (` (let (((, temp-buffer) - (get-buffer-create (generate-new-buffer-name " *temp*")))) - (unwind-protect - (with-current-buffer (, temp-buffer) - (,@ forms)) - (and (buffer-name (, temp-buffer)) - (kill-buffer (, temp-buffer)))))))) - -;; This function was imported Emacs 20.3. -(defun-maybe last (x &optional n) - "Return the last link of the list X. Its car is the last element. -If X is nil, return nil. -If N is non-nil, return the Nth-to-last link of X. -If N is bigger than the length of X, return X." - (if n - (let ((m 0) (p x)) - (while (consp p) - (setq m (1+ m) p (cdr p))) - (if (<= n 0) p - (if (< n m) (nthcdr (- m n) x) x))) - (while (cdr x) - (setq x (cdr x))) - x)) - -;; This function was imported Emacs 20.3. (cl function) -(defun-maybe butlast (x &optional n) - "Returns a copy of LIST with the last N elements removed." - (if (and n (<= n 0)) x - (nbutlast (copy-sequence x) n))) - -;; This function was imported Emacs 20.3. (cl function) -(defun-maybe nbutlast (x &optional n) - "Modifies LIST to remove the last N elements." - (let ((m (length x))) - (or n (setq n 1)) - (and (< n m) - (progn - (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) - x)))) - -;; This function was imported from XEmacs 21. -(defun-maybe split-string (string &optional pattern) - "Return a list of substrings of STRING which are separated by PATTERN. -If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"." - (or pattern - (setq pattern "[ \f\t\n\r\v]+")) - ;; The FSF version of this function takes care not to cons in case - ;; of infloop. Maybe we should synch? - (let (parts (start 0)) - (while (string-match pattern string start) - (setq parts (cons (substring string start (match-beginning 0)) parts) - start (match-end 0))) - (nreverse (cons (substring string start) parts)))) - - -;;; @ Emacs 20.3 emulation -;;; - -(defmacro-maybe string-as-unibyte (string) - "Return a unibyte string with the same individual bytes as STRING. -If STRING is unibyte, the result is STRING itself. -\[Emacs 20.3 emulating macro]" - string) - -(defmacro-maybe string-as-multibyte (string) - "Return a multibyte string with the same individual bytes as STRING. -If STRING is multibyte, the result is STRING itself. -\[Emacs 20.3 emulating macro]" - string) - - -;;; @ XEmacs emulation -;;; - -(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 -;;; - -(or (fboundp 'char-int) - (fset 'char-int (symbol-function 'identity)) - ) -(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)) - ) + This function ensures that none of these modifications will take place." + (as-binary-input-file + ;; Returns list absolute file name and length of data inserted. + (insert-file-contents-literally filename visit beg end replace))) ;;; @ for text/richtext and text/enriched