-;;; poe.el --- Emulation module for each Emacs variants
+;;; poe.el --- Portable Outfit for Emacsen; -*-byte-compile-dynamic: t;-*-
;; Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc.
;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.
+;;; Commentary:
+
+;; This modules does not includes MULE related features. MULE related
+;; features are supported by `poem'.
+
;;; Code:
+(provide 'poe)
+
(defmacro defun-maybe (name &rest everything-else)
(or (and (fboundp name)
- (not (get name 'defun-maybe))
- )
+ (not (get name 'defun-maybe)))
(` (or (fboundp (quote (, name)))
(progn
(defun (, name) (,@ everything-else))
))
)))
+(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)
+ ))
+ )))
+
+(defmacro-maybe defsubst (name arglist &rest body)
+ "Define an inline function. The syntax is just like that of `defun'."
+ (cons 'defun (cons name (cons arglist body)))
+ )
+
(defmacro defsubst-maybe (name &rest everything-else)
(or (and (fboundp name)
- (not (get name 'defsubst-maybe))
- )
+ (not (get name 'defsubst-maybe)))
(` (or (fboundp (quote (, name)))
(progn
(defsubst (, name) (,@ everything-else))
))
)))
-(defmacro defmacro-maybe (name &rest everything-else)
- (or (and (fboundp name)
- (not (get name 'defmacro-maybe))
- )
- (` (or (fboundp (quote (, name)))
+(defmacro defalias-maybe (symbol definition)
+ (setq symbol (eval symbol))
+ (or (and (fboundp symbol)
+ (not (get symbol 'defalias-maybe)))
+ (` (or (fboundp (quote (, symbol)))
(progn
- (defmacro (, name) (,@ everything-else))
- (put (quote (, name)) 'defmacro-maybe t)
+ (defalias (quote (, symbol)) (, definition))
+ (put (quote (, symbol)) 'defalias-maybe t)
))
)))
(put 'defsubst-maybe 'lisp-indent-function 'defun)
(put 'defmacro-maybe 'lisp-indent-function 'defun)
+(defmacro defvar-maybe (name &rest everything-else)
+ (or (and (boundp name)
+ (not (get name 'defvar-maybe)))
+ (` (or (boundp (quote (, name)))
+ (progn
+ (defvar (, name) (,@ everything-else))
+ (put (quote (, name)) 'defvar-maybe t)
+ ))
+ )))
+
(defmacro defconst-maybe (name &rest everything-else)
(or (and (boundp name)
(not (get name 'defconst-maybe))
))
)))
+(defmacro defun-maybe-cond (name args &optional doc &rest everything-else)
+ (unless (stringp doc)
+ (setq everything-else (cons doc everything-else)
+ doc nil)
+ )
+ (or (and (fboundp name)
+ (not (get name 'defun-maybe)))
+ (` (unless (fboundp (quote (, name)))
+ (cond (,@ (mapcar (function
+ (lambda (case)
+ (list (car case)
+ (if doc
+ (` (defun (, name) (, args)
+ (, doc)
+ (,@ (cdr case))))
+ (` (defun (, name) (, args)
+ (,@ (cdr case))))
+ ))))
+ everything-else)))
+ (put (quote (, name)) 'defun-maybe t)
+ ))))
+
+(defsubst subr-fboundp (symbol)
+ "Return t if SYMBOL's function definition is a built-in function."
+ (and (fboundp symbol)
+ (subrp (symbol-function symbol))))
+
(defconst-maybe emacs-major-version (string-to-int emacs-version))
(defconst-maybe emacs-minor-version
(string-to-int
(provide 'xemacs)
(require 'poe-xemacs)
)
- ((>= emacs-major-version 20)
- (require 'poe-19)
- (cond ((fboundp 'string)
+ ((> emacs-major-version 20))
+ ((= emacs-major-version 20)
+ (cond ((subr-fboundp 'string)
;; Emacs 20.3 or later
)
- ((fboundp 'concat-chars)
+ ((subr-fboundp 'concat-chars)
;; Emacs 20.1 or later
(defalias 'string 'concat-chars)
))
)
- ((>= emacs-major-version 19)
- (require 'poe-19)
- )
+ ((= emacs-major-version 19))
(t
(require 'poe-18)
))
-;;; @ Emacs 19 emulation
+;;; @ Emacs 19.23 emulation
;;;
(defun-maybe minibuffer-prompt-width ()
;;; @ Emacs 19.29 emulation
;;;
-(defvar path-separator ":"
+(defvar-maybe path-separator ":"
"Character used to separate concatenated paths.")
(defun-maybe buffer-substring-no-properties (start end)
(>= emacs-minor-version 29))
;; for Emacs 19.28 or earlier
(fboundp 'si:read-string)
- (progn
+ (eval-and-compile
(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]
+The third arg HISTORY, is dummy for compatibility.
See `read-from-minibuffer' for details of HISTORY argument."
(si:read-string prompt initial-input))
))
+(defun-maybe rassoc (key list)
+ "Return non-nil if KEY is `equal' to the cdr of an element of LIST.
+The value is actually the element of LIST whose cdr equals KEY."
+ (catch 'found
+ (while list
+ (if (equal (cdr (car list)) key)
+ (throw 'found (car list))
+ )
+ (setq list (cdr list)))
+ ))
+
+(defun-maybe file-name-sans-extension (filename)
+ "Return FILENAME sans final \"extension\".
+The extension, in a file name, is the part that follows the last `.'."
+ (save-match-data
+ (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
+ directory)
+ (if (string-match "\\.[^.]*\\'" file)
+ (if (setq directory (file-name-directory filename))
+ (expand-file-name (substring file 0 (match-beginning 0))
+ directory)
+ (substring file 0 (match-beginning 0)))
+ filename))))
+
+(defmacro-maybe make-local-hook (hook))
+
+;; They are not Emacs features
+
+(defmacro-maybe add-local-hook (hook function &optional append)
+ (if (fboundp 'make-local-hook)
+ (list 'add-hook hook function append t)
+ (list 'add-hook hook function append)
+ ))
+
+(defmacro-maybe remove-local-hook (hook function)
+ (if (fboundp 'make-local-hook)
+ (list 'remove-hook hook function t)
+ (list 'remove-hook hook function)
+ ))
+
;;; @ Emacs 19.30 emulation
;;;
-;; This function was imported Emacs 19.30.
+;; imported from 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
(get-buffer object)
(buffer-name (get-buffer object))))
-;; This macro was imported Emacs 19.33.
+;; imported from 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]"
;;; @ Emacs 20.1 emulation
;;;
-;; This macro was imported Emacs 20.2.
+;; imported from 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)))
-;; This macro was imported Emacs 20.3.
+;; imported from Emacs 20.3.
(defmacro-maybe unless (cond &rest body)
"(unless COND BODY...): if COND yields nil, do BODY, else return nil."
(cons 'if (cons cond (cons nil body))))
+;; imported from 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))
+
(defmacro-maybe save-current-buffer (&rest body)
"Save the current buffer; execute BODY; restore the current buffer.
Executes BODY just like `progn'."
(progn (,@ body))
(set-buffer orig-buffer)))))
-;; This macro was imported Emacs 20.2.
+;; imported from 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.
(set-buffer (, buffer))
(,@ body))))
-;; This macro was imported Emacs 20.2.
+;; imported from 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'.
(and (buffer-name (, temp-buffer))
(kill-buffer (, temp-buffer))))))))
-;; This macro was imported Emacs 20.2.
+;; imported from 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'."
(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))
+(defmacro-maybe combine-after-change-calls (&rest body)
+ "Execute BODY."
+ (cons 'progn body))
-;; This function was imported Emacs 20.3. (cl function)
+;; imported from 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)
+;; imported from Emacs 20.3. (cl function)
(defun-maybe nbutlast (x &optional n)
"Modifies LIST to remove the last N elements."
(let ((m (length x)))
(if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
x))))
-;; This function was imported from XEmacs 21.
+;; 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]+\"."
;;; @ Emacs 20.3 emulation
;;;
+;; imported from Emacs 20.3.91.
+(defvar-maybe temporary-file-directory
+ (file-name-as-directory
+ (cond ((memq system-type '(ms-dos windows-nt))
+ (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
+ ((memq system-type '(vax-vms axp-vms))
+ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
+ (t
+ (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
+ "The directory for writing temporary files.")
+
(defun-maybe line-beginning-position (&optional n)
"Return the character position of the first character on the current line.
With argument N not nil or 1, move forward N - 1 lines first.
;;; @ XEmacs emulation
;;;
+(defun-maybe find-face (face-or-name)
+ "Retrieve the face of the given name.
+If FACE-OR-NAME is a face object, it is simply returned.
+Otherwise, FACE-OR-NAME should be a symbol. If there is no such face,
+nil is returned. Otherwise the associated face object is returned.
+\[XEmacs emulating function]"
+ (car (memq face-or-name (face-list)))
+ )
+
(defun-maybe point-at-bol (&optional n buffer)
"Return the character position of the first character on the current line.
With argument N not nil or 1, move forward N - 1 lines first.
(make-obsolete oldfun newfun)
)
+(when (subr-fboundp 'read-event)
+ ;; for Emacs 19 or later
-;;; @ end
+ (defun-maybe-cond next-command-event (&optional event prompt)
+ "Read an event object from the input stream.
+If EVENT is non-nil, it should be an event object and will be filled
+in and returned; otherwise a new event object will be created and
+returned.
+If PROMPT is non-nil, it should be a string and will be displayed in
+the echo area while this function is waiting for an event.
+\[XEmacs emulating function]"
+ ((subr-fboundp 'string)
+ ;; for Emacs 20.3 or later
+ (read-event prompt t)
+ )
+ (t
+ (if prompt (message prompt))
+ (read-event)
+ ))
+
+ (defsubst-maybe character-to-event (ch)
+ "Convert keystroke CH into an event structure, replete with bucky bits.
+Note that CH (the keystroke specifier) can be an integer, a character
+or a symbol such as 'clear. [XEmacs emulating function]"
+ ch)
+
+ (defun-maybe event-to-character (event)
+ "Return the character approximation to the given event object.
+If the event isn't a keypress, this returns nil.
+\[XEmacs emulating function]"
+ (cond ((symbolp event)
+ ;; mask is (BASE-TYPE MODIFIER-BITS) or nil.
+ (let ((mask (get event 'event-symbol-element-mask)))
+ (if mask
+ (let ((base (get (car mask) 'ascii-character)))
+ (if base
+ (logior base (car (cdr mask)))
+ )))))
+ ((integerp event) event)
+ ))
+ )
+
+
+;;; @ MULE 2 emulation
;;;
-(provide 'poe)
+(defun-maybe-cond cancel-undo-boundary ()
+ "Cancel undo boundary. [MULE 2.3 emulating function]"
+ ((boundp 'buffer-undo-list)
+ ;; for Emacs 19.7 or later
+ (if (and (consp buffer-undo-list)
+ ;; if car is nil.
+ (null (car buffer-undo-list)))
+ (setq buffer-undo-list (cdr buffer-undo-list))
+ ))
+ (t
+ ;; for anything older than Emacs 19.7.
+ ))
+
+
+;;; @ end
+;;;
;;; poe.el ends here
projects / elisp / apel.git / blobdiff