poe.el

   1 ;;; poe.el --- Portable Outfit for Emacsen; -*-byte-compile-dynamic: t;-*-
   2
   3 ;; Copyright (C) 1995,1996,1997,1998,1999 Free Software Foundation, Inc.
   4
   5 ;; Author: MORIOKA Tomohiko <tomo@m17n.org>
   6 ;; Keywords: emulation, compatibility, NEmacs, MULE, Emacs/mule, XEmacs
   7
   8 ;; This file is part of APEL (A Portable Emacs Library).
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This modules does not includes MULE related features.
  28 ;; MULE related features are supported by `poem'.
  29
  30 ;;; Code:
  31
  32 (require 'product)
  33 (product-provide (provide 'poe) (require 'apel-ver))
  34
  35 (or (boundp 'current-load-list) (setq current-load-list nil))
  36
  37 (put 'defun-maybe 'lisp-indent-function 'defun)
  38 (defmacro defun-maybe (name &rest everything-else)
  39   "Define NAME as a function if NAME is not defined.
  40 See also the function `defun'."
  41   (or (and (fboundp name)
  42            (not (get name 'defun-maybe)))
  43       (` (or (fboundp (quote (, name)))
  44              (prog1
  45                  (defun (, name) (,@ everything-else))
  46                ;; This `defun' will be compiled to `fset', which does
  47                ;; not update `load-history'.
  48                (setq current-load-list
  49                      (cons (quote (, name)) current-load-list))
  50                (put (quote (, name)) 'defun-maybe t))))))
  51
  52 (put 'defmacro-maybe 'lisp-indent-function 'defun)
  53 (defmacro defmacro-maybe (name &rest everything-else)
  54   "Define NAME as a macro if NAME is not defined.
  55 See also the function `defmacro'."
  56   (or (and (fboundp name)
  57            (not (get name 'defmacro-maybe)))
  58       (` (or (fboundp (quote (, name)))
  59              (prog1
  60                  (defmacro (, name) (,@ everything-else))
  61                (setq current-load-list
  62                      (cons (quote (, name)) current-load-list))
  63                (put (quote (, name)) 'defmacro-maybe t))))))
  64
  65 (put 'defsubst-maybe 'lisp-indent-function 'defun)
  66 (defmacro defsubst-maybe (name &rest everything-else)
  67   "Define NAME as an inline function if NAME is not defined.
  68 See also the macro `defsubst'."
  69   (or (and (fboundp name)
  70            (not (get name 'defsubst-maybe)))
  71       (` (or (fboundp (quote (, name)))
  72              (prog1
  73                  (defsubst (, name) (,@ everything-else))
  74                (setq current-load-list
  75                      (cons (quote (, name)) current-load-list))
  76                (put (quote (, name)) 'defsubst-maybe t))))))
  77
  78 (defmacro defalias-maybe (symbol definition)
  79   "Define SYMBOL as an alias for DEFINITION if SYMBOL is not defined.
  80 See also the function `defalias'."
  81   (setq symbol (eval symbol))
  82   (or (and (fboundp symbol)
  83            (not (get symbol 'defalias-maybe)))
  84       (` (or (fboundp (quote (, symbol)))
  85              (prog1
  86                  (defalias (quote (, symbol)) (, definition))
  87                (setq current-load-list
  88                      (cons (quote (, symbol)) current-load-list))
  89                (put (quote (, symbol)) 'defalias-maybe t))))))
  90
  91 (defmacro defvar-maybe (name &rest everything-else)
  92   "Define NAME as a variable if NAME is not defined.
  93 See also the function `defvar'."
  94   (or (and (boundp name)
  95            (not (get name 'defvar-maybe)))
  96       (` (or (boundp (quote (, name)))
  97              (prog1
  98                  (defvar (, name) (,@ everything-else))
  99                ;; byte-compiler will generate code to update
 100                ;; `load-history'.
 101                (put (quote (, name)) 'defvar-maybe t))))))
 102
 103 (defmacro defconst-maybe (name &rest everything-else)
 104   "Define NAME as a constant variable if NAME is not defined.
 105 See also the function `defconst'."
 106   (or (and (boundp name)
 107            (not (get name 'defconst-maybe)))
 108       (` (or (boundp (quote (, name)))
 109              (prog1
 110                  (defconst (, name) (,@ everything-else))
 111                ;; byte-compiler will generate code to update
 112                ;; `load-history'.
 113                (put (quote (, name)) 'defconst-maybe t))))))
 114
 115 (defmacro defun-maybe-cond (name args &optional doc &rest everything-else)
 116   (or (stringp doc)
 117       (setq everything-else (cons doc everything-else)
 118             doc nil))
 119   (or (and (fboundp name)
 120            (not (get name 'defun-maybe)))
 121       (` (or (fboundp (quote (, name)))
 122              (prog1
 123                  (cond
 124                   (,@ (mapcar
 125                        (function
 126                         (lambda (case)
 127                           (list (car case)
 128                                 (if doc
 129                                     (` (defun (, name) (, args)
 130                                          (, doc)
 131                                          (,@ (cdr case))))
 132                                   (` (defun (, name) (, args)
 133                                        (,@ (cdr case))))))))
 134                        everything-else)))
 135                (setq current-load-list
 136                      (cons (quote (, name)) current-load-list))
 137                (put (quote (, name)) 'defun-maybe t))))))
 138
 139 (defmacro defmacro-maybe-cond (name args &optional doc &rest everything-else)
 140   (or (stringp doc)
 141       (setq everything-else (cons doc everything-else)
 142             doc nil))
 143   (or (and (fboundp name)
 144            (not (get name 'defmacro-maybe)))
 145       (` (or (fboundp (quote (, name)))
 146              (prog1
 147                  (cond
 148                   (,@ (mapcar
 149                        (function
 150                         (lambda (case)
 151                           (list (car case)
 152                                 (if doc
 153                                     (` (defmacro (, name) (, args)
 154                                          (, doc)
 155                                          (,@ (cdr case))))
 156                                   (` (defmacro (, name) (, args)
 157                                        (,@ (cdr case))))))))
 158                        everything-else)))
 159                (setq current-load-list
 160                      (cons (quote (, name)) current-load-list))
 161                (put (quote (, name)) 'defmacro-maybe t))))))
 162
 163 (defun subr-fboundp (symbol)
 164   "Return t if SYMBOL's function definition is a built-in function."
 165   (and (fboundp symbol)
 166        (subrp (symbol-function symbol))))
 167
 168 (defconst-maybe emacs-major-version (string-to-int emacs-version))
 169 (defconst-maybe emacs-minor-version
 170   (string-to-int
 171    (substring emacs-version
 172               (string-match (format "%d\\." emacs-major-version)
 173                             emacs-version))))
 174
 175 (cond ((featurep 'xemacs)
 176        (require 'poe-xemacs)
 177        )
 178       ((string-match "XEmacs" emacs-version)
 179        (provide 'xemacs)
 180        (require 'poe-xemacs)
 181        )
 182       ((> emacs-major-version 20))
 183       ((= emacs-major-version 20)
 184        (cond ((subr-fboundp 'string)
 185               ;; Emacs 20.3 or later
 186               )
 187              ((subr-fboundp 'concat-chars)
 188               ;; Emacs 20.1 or later
 189               (defalias 'string 'concat-chars)
 190               ))
 191        )
 192       ((= emacs-major-version 19)
 193        ;; XXX: should do compile-time and load-time check before loading
 194        ;;      "localhook".  But, it is difficult since "localhook" is
 195        ;;      already loaded via "install" at compile-time.  any idea?
 196        (if (< emacs-minor-version 29)
 197            (require 'localhook)))
 198       (t
 199        (require 'poe-18)
 200        ;; XXX: should do compile-time and load-time check before loading
 201        ;;      "localhook".  But, it is difficult since "localhook" is
 202        ;;      already loaded via "install" at compile-time.  any idea?
 203        (require 'localhook)))
 204
 205 ;;; `eval-when-compile' is defined in "poe-18" under v18 with old compiler.
 206 (eval-when-compile (require 'static))
 207
 208 ;; `file-coding' was appeared in the spring of 1998, just before XEmacs
 209 ;; 21.0.  Therefore it is not provided in XEmacs with MULE versions 20.4
 210 ;; or earlier.
 211 (if (and (featurep 'xemacs) (featurep 'mule))
 212     (provide 'file-coding))
 213
 214 ;; imported from emacs-20.3/lisp/emacs-lisp/edebug.el.
 215 ;; `def-edebug-spec' is an autoloaded macro in v19 and later.
 216 (defmacro-maybe def-edebug-spec (symbol spec)
 217   "Set the edebug-form-spec property of SYMBOL according to SPEC.
 218 Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
 219 \(naming a function\), or a list."
 220   (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
 221
 222 (def-edebug-spec defun-maybe defun)
 223 (def-edebug-spec defmacro-maybe defmacro)
 224 (def-edebug-spec defsubst-maybe defun)
 225 (def-edebug-spec defun-maybe-cond
 226   (&define name lambda-list
 227            [&optional stringp]
 228            [&rest ([&not eval] [&rest sexp])]
 229            [&optional (eval [&optional ("interactive" interactive)] def-body)]
 230            &rest (&rest sexp)))
 231 (def-edebug-spec defmacro-maybe-cond
 232   (&define name lambda-list
 233            [&rest ([&not eval] [&rest sexp])]
 234            [&optional (eval def-body)]
 235            &rest (&rest sexp)))
 236
 237 ;;; Emacs 20.1 emulation
 238
 239 ;; imported from emacs-20.3/lisp/subr.el.
 240 (defmacro-maybe when (cond &rest body)
 241   "If COND yields non-nil, do BODY, else return nil."
 242   (list 'if cond (cons 'progn body)))
 243 ;; (def-edebug-spec when (&rest form))
 244
 245 ;; imported from emacs-20.3/lisp/subr.el.
 246 (defmacro-maybe unless (cond &rest body)
 247   "If COND yields nil, do BODY, else return nil."
 248   (cons 'if (cons cond (cons nil body))))
 249 ;; (def-edebug-spec unless (&rest form))
 250
 251
 252 ;;; @ Emacs 19.23 emulation
 253 ;;;
 254
 255 (defun-maybe minibuffer-prompt-width ()
 256   "Return the display width of the minibuffer prompt."
 257   (save-excursion
 258     (set-buffer (window-buffer (minibuffer-window)))
 259     (current-column)))
 260
 261
 262 ;;; @ Emacs 19.29 emulation
 263 ;;;
 264
 265 (defvar-maybe path-separator ":"
 266   "The directory separator in search paths, as a string.")
 267
 268 (defun-maybe buffer-substring-no-properties (start end)
 269   "Return the characters of part of the buffer, without the text properties.
 270 The two arguments START and END are character positions;
 271 they can be in either order.
 272 \[Emacs 19.29 emulating function]"
 273   (let ((string (buffer-substring start end)))
 274     (set-text-properties 0 (length string) nil string)
 275     string))
 276
 277 ;; imported from emacs-19.34/lisp/subr.el.
 278 (defun-maybe match-string (num &optional string)
 279   "Return string of text matched by last search.
 280 NUM specifies which parenthesized expression in the last regexp.
 281  Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
 282 Zero means the entire text matched by the whole regexp or whole string.
 283 STRING should be given if the last search was by `string-match' on STRING.
 284 \[Emacs 19.29 emulating function]"
 285   (if (match-beginning num)
 286       (if string
 287           (substring string (match-beginning num) (match-end num))
 288         (buffer-substring (match-beginning num) (match-end num)))))
 289
 290 (static-unless (or (featurep 'xemacs)
 291                    (>= emacs-major-version 20)
 292                    (and (= emacs-major-version 19)
 293                         (>= emacs-minor-version 29)))
 294   ;; for Emacs 19.28 or earlier
 295   (unless (fboundp 'si:read-string)
 296     (fset 'si:read-string (symbol-function 'read-string))
 297     (defun read-string (prompt &optional initial-input history)
 298       "Read a string from the minibuffer, prompting with string PROMPT.
 299 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
 300 The third arg HISTORY, is dummy for compatibility.
 301 See `read-from-minibuffer' for details of HISTORY argument."
 302       (si:read-string prompt initial-input))
 303     ))
 304
 305 (defun-maybe rassoc (key list)
 306   "Return non-nil if KEY is `equal' to the cdr of an element of LIST.
 307 The value is actually the element of LIST whose cdr equals KEY.
 308 Elements of LIST that are not conses are ignored.
 309 \[Emacs 19.29 emulating function]"
 310   (catch 'found
 311     (while list
 312       (cond ((not (consp (car list))))
 313             ((equal (cdr (car list)) key)
 314              (throw 'found (car list)) ))
 315       (setq list (cdr list)) )))
 316
 317 ;; imported from emacs-19.34/lisp/files.el.
 318 (defun-maybe file-name-sans-extension (filename)
 319   "Return FILENAME sans final \"extension\".
 320 The extension, in a file name, is the part that follows the last `.'.
 321 \[Emacs 19.29 emulating function]"
 322   (save-match-data
 323     (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
 324           directory)
 325       (if (string-match "\\.[^.]*\\'" file)
 326           (if (setq directory (file-name-directory filename))
 327               (expand-file-name (substring file 0 (match-beginning 0))
 328                                 directory)
 329             (substring file 0 (match-beginning 0)))
 330         filename))))
 331
 332
 333 ;;; @ Emacs 19.30 emulation
 334 ;;;
 335
 336 ;; imported from emacs-19.34/lisp/subr.el.
 337 (defun-maybe add-to-list (list-var element)
 338   "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
 339 The test for presence of ELEMENT is done with `equal'.
 340 If you want to use `add-to-list' on a variable that is not defined
 341 until a certain package is loaded, you should put the call to `add-to-list'
 342 into a hook function that will be run only after loading the package.
 343 `eval-after-load' provides one way to do this.  In some cases
 344 other hooks, such as major mode hooks, can do the job.
 345 \[Emacs 19.30 emulating function]"
 346   (or (member element (symbol-value list-var))
 347       (set list-var (cons element (symbol-value list-var)))))
 348
 349 (cond ((fboundp 'insert-file-contents-literally))
 350       ((boundp 'file-name-handler-alist)
 351        (defun insert-file-contents-literally
 352          (filename &optional visit beg end replace)
 353          "Like `insert-file-contents', q.v., but only reads in the file.
 354 A buffer may be modified in several ways after reading into the buffer due
 355 to advanced Emacs features, such as file-name-handlers, format decoding,
 356 find-file-hooks, etc.
 357   This function ensures that none of these modifications will take place.
 358 \[Emacs 19.30 emulating function]"
 359          (let (file-name-handler-alist)
 360            (insert-file-contents filename visit beg end replace)))
 361        )
 362       (t
 363        (defalias 'insert-file-contents-literally 'insert-file-contents)
 364        ))
 365
 366
 367 ;;; @ Emacs 19.31 emulation
 368 ;;;
 369
 370 (defun-maybe buffer-live-p (object)
 371   "Return non-nil if OBJECT is a buffer which has not been killed.
 372 Value is nil if OBJECT is not a buffer or if it has been killed.
 373 \[Emacs 19.31 emulating function]"
 374   (and object
 375        (get-buffer object)
 376        (buffer-name (get-buffer object))
 377        t))
 378
 379 ;; imported from emacs-19.34/lisp/window.el.
 380 (defmacro-maybe save-selected-window (&rest body)
 381   "Execute BODY, then select the window that was selected before BODY.
 382 \[Emacs 19.31 emulating function]"
 383   (list 'let
 384         '((save-selected-window-window (selected-window)))
 385         (list 'unwind-protect
 386               (cons 'progn body)
 387               (list 'select-window 'save-selected-window-window))))
 388
 389 (defun-maybe-cond convert-standard-filename (filename)
 390   "Convert a standard file's name to something suitable for the current OS.
 391 This function's standard definition is trivial; it just returns the argument.
 392 However, on some systems, the function is redefined
 393 with a definition that really does change some file names.
 394 Under `windows-nt' or `ms-dos', it refers `filename-replacement-alist' and
 395 `filename-limit-length' for the basic filename and each parent directory name.
 396 \[Emacs 19.31 emulating function]"
 397   ((memq system-type '(windows-nt ms-dos))
 398    (require 'filename)
 399    (let* ((names (split-string filename "/"))
 400           (drive-name (car names))
 401           (filter (function (lambda (string)
 402                               (filename-maybe-truncate-by-size
 403                                (filename-special-filter string))))))
 404      (cond ((eq 1 (length names))
 405             (funcall filter drive-name))
 406            ((string-match "^[^/]:$" drive-name)
 407             (concat drive-name "/" (mapconcat filter (cdr names) "/")))
 408            (t (mapconcat filter names "/")))))
 409   (t filename))
 410
 411
 412 ;;; @ Emacs 20.1 emulation
 413 ;;;
 414
 415 ;; imported from emacs-20.3/lisp/subr.el.
 416 (defsubst-maybe caar (x)
 417   "Return the car of the car of X."
 418   (car (car x)))
 419
 420 ;; imported from emacs-20.3/lisp/subr.el.
 421 (defsubst-maybe cadr (x)
 422   "Return the car of the cdr of X."
 423   (car (cdr x)))
 424
 425 ;; imported from emacs-20.3/lisp/subr.el.
 426 (defsubst-maybe cdar (x)
 427   "Return the cdr of the car of X."
 428   (cdr (car x)))
 429
 430 ;; imported from emacs-20.3/lisp/subr.el.
 431 (defsubst-maybe cddr (x)
 432   "Return the cdr of the cdr of X."
 433   (cdr (cdr x)))
 434
 435 ;; imported from emacs-20.3/lisp/subr.el.
 436 (defun-maybe last (x &optional n)
 437   "Return the last link of the list X.  Its car is the last element.
 438 If X is nil, return nil.
 439 If N is non-nil, return the Nth-to-last link of X.
 440 If N is bigger than the length of X, return X."
 441   (if n
 442       (let ((m 0) (p x))
 443         (while (consp p)
 444           (setq m (1+ m) p (cdr p)))
 445         (if (<= n 0) p
 446           (if (< n m) (nthcdr (- m n) x) x)))
 447     (while (cdr x)
 448       (setq x (cdr x)))
 449     x))
 450
 451 ;; In Emacs 20.3, save-current-buffer is defined in src/editfns.c.
 452 (defmacro-maybe save-current-buffer (&rest body)
 453   "Save the current buffer; execute BODY; restore the current buffer.
 454 Executes BODY just like `progn'."
 455   (` (let ((orig-buffer (current-buffer)))
 456        (unwind-protect
 457            (progn (,@ body))
 458          (if (buffer-live-p orig-buffer)
 459              (set-buffer orig-buffer))))))
 460
 461 ;; imported from emacs-20.3/lisp/subr.el. (with macro style change)
 462 (defmacro-maybe with-current-buffer (buffer &rest body)
 463   "Execute the forms in BODY with BUFFER as the current buffer.
 464 The value returned is the value of the last form in BODY.
 465 See also `with-temp-buffer'."
 466   (` (save-current-buffer
 467        (set-buffer (, buffer))
 468        (,@ body))))
 469
 470 ;; imported from emacs-20.3/lisp/subr.el. (with macro style change)
 471 (defmacro-maybe with-temp-file (file &rest forms)
 472   "Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
 473 The value of the last form in FORMS is returned, like `progn'.
 474 See also `with-temp-buffer'."
 475   (let ((temp-file (make-symbol "temp-file"))
 476         (temp-buffer (make-symbol "temp-buffer")))
 477     (` (let (((, temp-file) (, file))
 478              ((, temp-buffer)
 479               (get-buffer-create (generate-new-buffer-name " *temp file*"))))
 480          (unwind-protect
 481              (prog1
 482                  (with-current-buffer (, temp-buffer)
 483                    (,@ forms))
 484                (with-current-buffer (, temp-buffer)
 485                  (widen)
 486                  (write-region (point-min) (point-max) (, temp-file) nil 0)))
 487            (and (buffer-name (, temp-buffer))
 488                 (kill-buffer (, temp-buffer))))))))
 489
 490 ;; imported from emacs-20.3/lisp/subr.el. (with macro style change)
 491 (defmacro-maybe with-temp-buffer (&rest forms)
 492   "Create a temporary buffer, and evaluate FORMS there like `progn'.
 493 See also `with-temp-file' and `with-output-to-string'."
 494   (let ((temp-buffer (make-symbol "temp-buffer")))
 495     (` (let (((, temp-buffer)
 496               (get-buffer-create (generate-new-buffer-name " *temp*"))))
 497          (unwind-protect
 498              (with-current-buffer (, temp-buffer)
 499                (,@ forms))
 500            (and (buffer-name (, temp-buffer))
 501                 (kill-buffer (, temp-buffer))))))))
 502
 503 (defmacro-maybe combine-after-change-calls (&rest body)
 504   "Execute BODY."
 505   (cons 'progn body))
 506
 507 ;; imported from emacs-20.3/lisp/subr.el.
 508 (defun-maybe functionp (object)
 509   "Non-nil if OBJECT is a type of object that can be called as a function."
 510   (or (subrp object) (byte-code-function-p object)
 511       (eq (car-safe object) 'lambda)
 512       (and (symbolp object) (fboundp object))))
 513
 514 ;; imported from emacs-20.3/lisp/emacs-lisp/cl.el.
 515 (defun-maybe butlast (x &optional n)
 516   "Returns a copy of LIST with the last N elements removed."
 517   (if (and n (<= n 0)) x
 518     (nbutlast (copy-sequence x) n)))
 519
 520 ;; imported from emacs-20.3/lisp/emacs-lisp/cl.el.
 521 (defun-maybe nbutlast (x &optional n)
 522   "Modifies LIST to remove the last N elements."
 523   (let ((m (length x)))
 524     (or n (setq n 1))
 525     (and (< n m)
 526          (progn
 527            (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
 528            x))))
 529
 530 ;; imported from XEmacs 21.
 531 (defun-maybe split-string (string &optional pattern)
 532   "Return a list of substrings of STRING which are separated by PATTERN.
 533 If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
 534   (or pattern
 535       (setq pattern "[ \f\t\n\r\v]+"))
 536   ;; The FSF version of this function takes care not to cons in case
 537   ;; of infloop.  Maybe we should synch?
 538   (let (parts (start 0))
 539     (while (string-match pattern string start)
 540       (setq parts (cons (substring string start (match-beginning 0)) parts)
 541             start (match-end 0)))
 542     (nreverse (cons (substring string start) parts))))
 543
 544 ;; emulating char-before of Emacs 20.
 545 (static-condition-case nil
 546     ;; compile-time check.
 547     (progn
 548       ;; XXX: this file is already loaded at compile-time,
 549       ;; so this test will always success.
 550       (char-before)
 551       ;; If our definition is found at compile-time, signal an error.
 552       ;; XXX: should signal more specific error.
 553       (if (get 'char-before 'defun-maybe)
 554           (error "")))
 555   (wrong-number-of-arguments            ; Mule 1.*, 2.*.
 556    ;; load-time check.
 557    (or (fboundp 'si:char-before)
 558        (progn
 559          (fset 'si:char-before (symbol-function 'char-before))
 560          (put 'char-before 'defun-maybe t)
 561          ;; takes IGNORED for backward compatibility.
 562          (defun char-before (&optional pos ignored)
 563            "\
 564 Return character in current buffer preceding position POS.
 565 POS is an integer or a buffer pointer.
 566 If POS is out of range, the value is nil."
 567            (si:char-before (or pos (point)))))))
 568   (void-function                        ; non-Mule.
 569    ;; load-time check.
 570    (defun-maybe char-before (&optional pos)
 571      "\
 572 Return character in current buffer preceding position POS.
 573 POS is an integer or a buffer pointer.
 574 If POS is out of range, the value is nil."
 575      (if pos
 576          (save-excursion
 577            (and (= (goto-char pos) (point))
 578                 (not (bobp))
 579                 (preceding-char)))
 580        (and (not (bobp))
 581             (preceding-char)))))
 582   (error                                ; found our definition at compile-time.
 583    ;; load-time check.
 584    (condition-case nil
 585        (char-before)
 586      (wrong-number-of-arguments         ; Mule 1.*, 2.*.
 587       (or (fboundp 'si:char-before)
 588           (progn
 589             (fset 'si:char-before (symbol-function 'char-before))
 590             (put 'char-before 'defun-maybe t)
 591             ;; takes IGNORED for backward compatibility.
 592             (defun char-before (&optional pos ignored)
 593               "\
 594 Return character in current buffer preceding position POS.
 595 POS is an integer or a buffer pointer.
 596 If POS is out of range, the value is nil."
 597               (si:char-before (or pos (point)))))))
 598      (void-function                     ; non-Mule.
 599       (defun-maybe char-before (&optional pos)
 600         "\
 601 Return character in current buffer preceding position POS.
 602 POS is an integer or a buffer pointer.
 603 If POS is out of range, the value is nil."
 604         (if pos
 605             (save-excursion
 606               (and (= (goto-char pos) (point))
 607                    (not (bobp))
 608                    (preceding-char)))
 609           (and (not (bobp))
 610                (preceding-char))))))))
 611
 612 ;; emulating char-after of Emacs 20.
 613 (static-condition-case nil
 614     ;; compile-time check.
 615     (progn
 616       ;; XXX: this file is already loaded at compile-time,
 617       ;; so this test will always success.
 618       (char-after)
 619       ;; If our definition is found at compile-time, signal an error.
 620       ;; XXX: should signal more specific error.
 621       (if (get 'char-after 'defun-maybe)
 622           (error "")))
 623   (wrong-number-of-arguments            ; v18, v19
 624    ;; load-time check.
 625    (or (fboundp 'si:char-after)
 626        (progn
 627          (fset 'si:char-after (symbol-function 'char-after))
 628          (put 'char-after 'defun-maybe t)
 629          (defun char-after (&optional pos)
 630            "\
 631 Return character in current buffer at position POS.
 632 POS is an integer or a buffer pointer.
 633 If POS is out of range, the value is nil."
 634            (si:char-after (or pos (point)))))))
 635   (void-function                        ; NEVER happen?
 636    ;; load-time check.
 637    (defun-maybe char-after (&optional pos)
 638      "\
 639 Return character in current buffer at position POS.
 640 POS is an integer or a buffer pointer.
 641 If POS is out of range, the value is nil."
 642      (if pos
 643          (save-excursion
 644            (and (= (goto-char pos) (point))
 645                 (not (eobp))
 646                 (following-char)))
 647        (and (not (eobp))
 648             (following-char)))))
 649   (error                                ; found our definition at compile-time.
 650    ;; load-time check.
 651    (condition-case nil
 652        (char-after)
 653      (wrong-number-of-arguments         ; v18, v19
 654       (or (fboundp 'si:char-after)
 655           (progn
 656             (fset 'si:char-after (symbol-function 'char-after))
 657             (put 'char-after 'defun-maybe t)
 658             (defun char-after (&optional pos)
 659               "\
 660 Return character in current buffer at position POS.
 661 POS is an integer or a buffer pointer.
 662 If POS is out of range, the value is nil."
 663               (si:char-after (or pos (point)))))))
 664      (void-function                     ; NEVER happen?
 665       (defun-maybe char-after (&optional pos)
 666         "\
 667 Return character in current buffer at position POS.
 668 POS is an integer or a buffer pointer.
 669 If POS is out of range, the value is nil."
 670         (if pos
 671             (save-excursion
 672               (and (= (goto-char pos) (point))
 673                    (not (eobp))
 674                    (following-char)))
 675           (and (not (eobp))
 676                (following-char))))))))
 677
 678
 679 ;;; @ Emacs 20.3 emulation
 680 ;;;
 681
 682 ;; imported from emacs-20.3/lisp/files.el.
 683 (defvar-maybe temporary-file-directory
 684   (file-name-as-directory
 685    (cond ((memq system-type '(ms-dos windows-nt))
 686           (or (getenv "TEMP") (getenv "TMPDIR") (getenv "TMP") "c:/temp"))
 687          ((memq system-type '(vax-vms axp-vms))
 688           (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "SYS$SCRATCH:"))
 689          (t
 690           (or (getenv "TMPDIR") (getenv "TMP") (getenv "TEMP") "/tmp"))))
 691   "The directory for writing temporary files.")
 692
 693 (defun-maybe line-beginning-position (&optional n)
 694   "Return the character position of the first character on the current line.
 695 With argument N not nil or 1, move forward N - 1 lines first.
 696 If scan reaches end of buffer, return that position.
 697 This function does not move point."
 698   (save-excursion
 699     (forward-line (1- (or n 1)))
 700     (point)))
 701
 702 (defun-maybe line-end-position (&optional n)
 703   "Return the character position of the last character on the current line.
 704 With argument N not nil or 1, move forward N - 1 lines first.
 705 If scan reaches end of buffer, return that position.
 706 This function does not move point."
 707   (save-excursion
 708     (end-of-line (or n 1))
 709     (point)))
 710
 711 (defun-maybe string (&rest chars)
 712   "Concatenate all the argument characters and make the result a string."
 713   (mapconcat (function char-to-string) chars ""))
 714
 715
 716 ;;; @ XEmacs emulation
 717 ;;;
 718
 719 (defun-maybe find-face (face-or-name)
 720   "Retrieve the face of the given name.
 721 If FACE-OR-NAME is a face object, it is simply returned.
 722 Otherwise, FACE-OR-NAME should be a symbol.  If there is no such face,
 723 nil is returned.  Otherwise the associated face object is returned.
 724 \[XEmacs emulating function]"
 725   (car (memq face-or-name (face-list))))
 726
 727 (defun-maybe point-at-bol (&optional n buffer)
 728   "Return the character position of the first character on the current line.
 729 With argument N not nil or 1, move forward N - 1 lines first.
 730 If scan reaches end of buffer, return that position.
 731 This function does not move point.
 732 \[XEmacs emulating function]"
 733   (save-excursion
 734     (if buffer (set-buffer buffer))
 735     (forward-line (1- (or n 1)))
 736     (point)))
 737
 738 (defun-maybe point-at-eol (&optional n buffer)
 739   "Return the character position of the last character on the current line.
 740 With argument N not nil or 1, move forward N - 1 lines first.
 741 If scan reaches end of buffer, return that position.
 742 This function does not move point.
 743 \[XEmacs emulating function]"
 744   (save-excursion
 745     (if buffer (set-buffer buffer))
 746     (end-of-line (or n 1))
 747     (point)))
 748
 749 (defsubst-maybe define-obsolete-function-alias (oldfun newfun)
 750   "Define OLDFUN as an obsolete alias for function NEWFUN.
 751 This makes calling OLDFUN equivalent to calling NEWFUN and marks OLDFUN
 752 as obsolete.
 753 \[XEmacs emulating function]"
 754   (defalias oldfun newfun)
 755   (make-obsolete oldfun newfun))
 756
 757 (when (subr-fboundp 'read-event)
 758   ;; for Emacs 19 or later
 759
 760   (defun-maybe-cond next-command-event (&optional event prompt)
 761     "Read an event object from the input stream.
 762 If EVENT is non-nil, it should be an event object and will be filled
 763 in and returned; otherwise a new event object will be created and
 764 returned.
 765 If PROMPT is non-nil, it should be a string and will be displayed in
 766 the echo area while this function is waiting for an event.
 767 \[XEmacs emulating function]"
 768     ((subr-fboundp 'string)
 769      ;; for Emacs 20.3 or later
 770      (read-event prompt t)
 771      )
 772     (t
 773      (if prompt (message prompt))
 774      (read-event)
 775      ))
 776
 777   (defsubst-maybe character-to-event (ch)
 778     "Convert keystroke CH into an event structure, replete with bucky bits.
 779 Note that CH (the keystroke specifier) can be an integer, a character
 780 or a symbol such as 'clear. [XEmacs emulating function]"
 781     ch)
 782
 783   (defsubst-maybe event-to-character (event)
 784     "Return the character approximation to the given event object.
 785 If the event isn't a keypress, this returns nil.
 786 \[XEmacs emulating function]"
 787     (cond ((symbolp event)
 788            ;; mask is (BASE-TYPE MODIFIER-BITS) or nil.
 789            (let ((mask (get event 'event-symbol-element-mask)))
 790              (if mask
 791                  (let ((base (get (car mask) 'ascii-character)))
 792                    (if base
 793                        (logior base (car (cdr mask)))
 794                      )))))
 795           ((integerp event) event)))
 796   )
 797
 798
 799 ;;; @ MULE 2 emulation
 800 ;;;
 801
 802 (defun-maybe-cond cancel-undo-boundary ()
 803   "Cancel undo boundary. [MULE 2.3 emulating function]"
 804   ((boundp 'buffer-undo-list)
 805    ;; for Emacs 19.7 or later
 806    (if (and (consp buffer-undo-list)
 807             ;; if car is nil.
 808             (null (car buffer-undo-list)))
 809        (setq buffer-undo-list (cdr buffer-undo-list))
 810      ))
 811   (t
 812    ;; for anything older than Emacs 19.7.
 813    ))
 814
 815
 816 ;;; @ end
 817 ;;;
 818
 819 ;;; poe.el ends here